summaryrefslogtreecommitdiffstats
path: root/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10
diff options
context:
space:
mode:
authorJocelyn Turcotte <jocelyn.turcotte@digia.com>2014-08-08 14:30:41 +0200
committerJocelyn Turcotte <jocelyn.turcotte@digia.com>2014-08-12 13:49:54 +0200
commitab0a50979b9eb4dfa3320eff7e187e41efedf7a9 (patch)
tree498dfb8a97ff3361a9f7486863a52bb4e26bb898 /chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10
parent4ce69f7403811819800e7c5ae1318b2647e778d1 (diff)
Update Chromium to beta version 37.0.2062.68
Change-Id: I188e3b5aff1bec75566014291b654eb19f5bc8ca Reviewed-by: Andras Becsi <andras.becsi@digia.com>
Diffstat (limited to 'chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10')
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Archive/Zip.pm2029
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Archive/Zip/Archive.pm786
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Archive/Zip/BufferedFileHandle.pm131
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Archive/Zip/DirectoryMember.pm82
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Archive/Zip/FAQ.pod467
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Archive/Zip/FileMember.pm64
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Archive/Zip/Member.pm951
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Archive/Zip/MemberRead.pm333
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Archive/Zip/MockFileHandle.pm69
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Archive/Zip/NewFileMember.pm79
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Archive/Zip/StringMember.pm64
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Archive/Zip/Tree.pm46
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Archive/Zip/ZipFileMember.pm413
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Bundle/LWP.pm43
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/CPAN.pm12583
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/CPAN/API/HOWTO.pm44
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/CPAN/Admin.pm230
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/CPAN/Debug.pm79
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/CPAN/DeferedCode.pm16
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/CPAN/FirstTime.pm1636
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/CPAN/HandleConfig.pm719
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/CPAN/Kwalify.pm130
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/CPAN/Kwalify/distroprefs.dd137
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/CPAN/Kwalify/distroprefs.yml84
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/CPAN/Nox.pm51
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/CPAN/Queue.pm193
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/CPAN/Reporter.pm1487
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/CPAN/Reporter.pod224
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/CPAN/Reporter/API.pod135
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/CPAN/Reporter/Config.pm764
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/CPAN/Reporter/Config.pod342
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/CPAN/Reporter/FAQ.pod138
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/CPAN/Reporter/History.pm404
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/CPAN/Reporter/History.pod130
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/CPAN/Reporter/PrereqCheck.pm182
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/CPAN/Reporter/PrereqCheck.pod75
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/CPAN/Tarzip.pm352
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/CPAN/Version.pm173
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Config/Tiny.pm267
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Devel/Symdump.pm468
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Devel/Symdump/Export.pm39
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/File/._Temp.pmbin82 -> 0 bytes
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/File/Copy/Recursive.pm641
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/File/HomeDir.pm619
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/File/HomeDir/Darwin.pm185
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/File/HomeDir/Driver.pm19
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/File/HomeDir/MacOS9.pm94
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/File/HomeDir/Unix.pm167
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/File/HomeDir/Windows.pm176
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/File/Listing.pm409
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/File/Temp.pm2425
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/File/pushd.pm229
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/File/pushd.pod145
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/HTML/Form.pm1400
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/HTML/Tagset.pm471
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/HTTP/Cookies.pm775
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/HTTP/Cookies/Microsoft.pm328
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/HTTP/Cookies/Netscape.pm116
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/HTTP/Daemon.pm885
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/HTTP/Date.pm389
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/HTTP/Headers.pm737
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/HTTP/Headers/Auth.pm98
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/HTTP/Headers/ETag.pm94
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/HTTP/Headers/Util.pm184
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/HTTP/Message.pm762
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/HTTP/Negotiate.pm529
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/HTTP/Request.pm210
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/HTTP/Request/Common.pm493
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/HTTP/Response.pm559
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/HTTP/Status.pm247
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/IO/CaptureOutput.pm317
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/IO/CaptureOutput.pod180
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/IO/Compress/Adapter/Bzip2.pm162
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/IO/Compress/Bzip2.pm758
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/IO/String.pm551
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/IO/Uncompress/Adapter/Bunzip2.pm199
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/IO/Uncompress/Bunzip2.pm858
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/IPC/Run3.pm814
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/IPC/Run3/ProfArrayBuffer.pm86
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/IPC/Run3/ProfLogReader.pm157
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/IPC/Run3/ProfLogger.pm139
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/IPC/Run3/ProfPP.pm156
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/IPC/Run3/ProfReporter.pm256
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/LWP.pm655
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/LWP/Authen/Basic.pm36
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/LWP/Authen/Digest.pm90
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/LWP/Authen/Ntlm.pm195
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/LWP/ConnCache.pm310
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/LWP/Debug.pm134
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/LWP/DebugFile.pm220
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/LWP/MediaTypes.pm299
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/LWP/MemberMixin.pm44
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/LWP/Protocol.pm290
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/LWP/Protocol/GHTTP.pm73
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/LWP/Protocol/cpan.pm72
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/LWP/Protocol/data.pm52
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/LWP/Protocol/file.pm148
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/LWP/Protocol/ftp.pm562
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/LWP/Protocol/gopher.pm214
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/LWP/Protocol/http.pm471
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/LWP/Protocol/http10.pm303
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/LWP/Protocol/https.pm46
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/LWP/Protocol/https10.pm75
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/LWP/Protocol/loopback.pm26
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/LWP/Protocol/mailto.pm183
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/LWP/Protocol/nntp.pm150
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/LWP/Protocol/nogo.pm24
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/LWP/RobotUA.pm317
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/LWP/Simple.pm352
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/LWP/UserAgent.pm1424
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/LWP/media.types118
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Module/ScanDeps.pm1324
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Module/ScanDeps/DataFeed.pm143
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Module/Signature.pm884
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Net/HTTP.pm276
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Net/HTTP/Methods.pm558
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Net/HTTP/NB.pm105
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Net/HTTPS.pm56
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Net/Telnet.pm5252
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/PAR/Dist.pm1191
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Pod/Coverage.pm486
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Pod/Coverage/CountParents.pm77
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Pod/Coverage/ExportOnly.pm53
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Pod/Coverage/Overloader.pm37
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Pod/Escapes.pm721
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Pod/Simple.pm1520
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Pod/Simple.pod218
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Pod/Simple/BlackBox.pm1923
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Pod/Simple/Checker.pm171
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Pod/Simple/Debug.pm151
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Pod/Simple/DumpAsText.pm130
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Pod/Simple/DumpAsXML.pm146
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Pod/Simple/HTML.pm889
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Pod/Simple/HTMLBatch.pm1342
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Pod/Simple/HTMLLegacy.pm104
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Pod/Simple/LinkSection.pm145
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Pod/Simple/Methody.pm127
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Pod/Simple/Progress.pm93
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Pod/Simple/PullParser.pm795
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Pod/Simple/PullParserEndToken.pm93
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Pod/Simple/PullParserStartToken.pm130
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Pod/Simple/PullParserTextToken.pm101
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Pod/Simple/PullParserToken.pm138
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Pod/Simple/RTF.pm674
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Pod/Simple/Search.pm1016
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Pod/Simple/SimpleTree.pm155
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Pod/Simple/Subclassing.pod922
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Pod/Simple/Text.pm152
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Pod/Simple/TextContent.pm87
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Pod/Simple/TiedOutFH.pm103
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Pod/Simple/Transcode.pm33
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Pod/Simple/TranscodeDumb.pm63
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Pod/Simple/TranscodeSmart.pm42
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Pod/Simple/XMLOutStream.pm157
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Probe/Perl.pm272
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Tee.pm187
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Tee.pod142
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Term/ReadLine/Perl.pm153
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Term/ReadLine/readline.pm4610
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Test/Pod.pm270
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Test/Pod/Coverage.pm305
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Test/Reporter.pm1085
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Test/Reporter/Transport.pm118
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Test/Reporter/Transport/File.pm103
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Test/Reporter/Transport/HTTPGateway.pm128
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Test/Reporter/Transport/Mail/Send.pm121
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Test/Reporter/Transport/Net/SMTP.pm216
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Test/Reporter/Transport/Net/SMTP/TLS.pm86
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Test/YAML.pm268
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI.pm1021
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/Escape.pm218
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/Heuristic.pm222
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/QueryParam.pm200
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/Split.pm96
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/URL.pm305
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/WithBase.pm171
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/_foreign.pm6
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/_generic.pm249
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/_ldap.pm140
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/_login.pm10
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/_query.pm81
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/_segment.pm20
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/_server.pm106
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/_userpass.pm51
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/data.pm140
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/file.pm329
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/file/Base.pm80
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/file/FAT.pm23
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/file/Mac.pm120
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/file/OS2.pm28
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/file/QNX.pm18
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/file/Unix.pm55
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/file/Win32.pm84
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/ftp.pm45
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/gopher.pm94
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/http.pm25
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/https.pm7
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/ldap.pm122
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/ldapi.pm30
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/ldaps.pm7
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/mailto.pm72
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/mms.pm8
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/news.pm68
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/nntp.pm6
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/pop.pm68
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/rlogin.pm7
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/rsync.pm12
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/rtsp.pm8
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/rtspu.pm8
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/sip.pm86
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/sips.pm7
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/snews.pm8
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/ssh.pm9
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/telnet.pm7
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/tn3270.pm7
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/urn.pm97
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/urn/isbn.pm102
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/urn/oid.pm18
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/WWW/RobotRules.pm444
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/WWW/RobotRules/AnyDBM_File.pm170
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/XML/NamespaceSupport.pm583
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/XML/SAX.pm379
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/XML/SAX/Base.pm3164
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/XML/SAX/DocumentLocator.pm134
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/XML/SAX/Exception.pm126
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/XML/SAX/Intro.pod407
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/XML/SAX/ParserFactory.pm232
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/XML/SAX/PurePerl.pm746
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/XML/SAX/PurePerl/DTDDecls.pm603
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/XML/SAX/PurePerl/DebugHandler.pm95
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/XML/SAX/PurePerl/DocType.pm180
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/XML/SAX/PurePerl/EncodingDetect.pm105
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/XML/SAX/PurePerl/Exception.pm67
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/XML/SAX/PurePerl/NoUnicodeExt.pm28
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/XML/SAX/PurePerl/Productions.pm151
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/XML/SAX/PurePerl/Reader.pm137
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/XML/SAX/PurePerl/Reader/NoUnicodeExt.pm25
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/XML/SAX/PurePerl/Reader/Stream.pm84
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/XML/SAX/PurePerl/Reader/String.pm61
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/XML/SAX/PurePerl/Reader/URI.pm57
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/XML/SAX/PurePerl/Reader/UnicodeExt.pm23
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/XML/SAX/PurePerl/UnicodeExt.pm22
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/XML/SAX/PurePerl/XMLDecl.pm129
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/XML/SAX/placeholder.pl1
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/YAML.pm788
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/YAML/Base.pm200
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/YAML/Dumper.pm587
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/YAML/Dumper/Base.pm137
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/YAML/Error.pm220
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/YAML/Loader.pm780
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/YAML/Loader/Base.pm64
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/YAML/Marshall.pm77
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/YAML/Node.pm297
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/YAML/Tag.pm48
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/YAML/Types.pm251
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/auto/Tee/ptee157
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Alias.pm370
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Compress/Bzip2.pm1579
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Compress/Raw/Bzip2.pm329
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Cwd.pm763
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Digest/SHA.pm669
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/File/Spec.pm336
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/File/Spec/Cygwin.pm154
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/File/Spec/Epoc.pm78
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/File/Spec/Functions.pm109
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/File/Spec/Mac.pm780
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/File/Spec/OS2.pm273
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/File/Spec/Unix.pm517
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/File/Spec/VMS.pm536
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/File/Spec/Win32.pm442
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/HTML/Entities.pm491
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/HTML/Filter.pm112
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/HTML/HeadParser.pm259
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/HTML/LinkExtor.pm187
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/HTML/Parser.pm1233
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/HTML/PullParser.pm211
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/HTML/TokeParser.pm371
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Math/BigInt/FastCalc.pm125
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS.pm967
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/FAQ.pod45
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/Header.pm371
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/Nameserver.pm703
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/Packet.pm749
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/Question.pm260
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR.pm1022
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/A.pm95
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/AAAA.pm124
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/AFSDB.pm122
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/CERT.pm178
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/CNAME.pm97
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/DNAME.pm90
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/EID.pm63
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/HINFO.pm125
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/IPSECKEY.pm237
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/ISDN.pm129
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/LOC.pm363
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/MB.pm99
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/MG.pm100
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/MINFO.pm118
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/MR.pm101
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/MX.pm135
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/NAPTR.pm210
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/NIMLOC.pm63
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/NS.pm106
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/NSAP.pm274
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/NULL.pm65
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/OPT.pm286
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/PTR.pm101
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/PX.pm153
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/RP.pm121
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/RT.pm133
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/SOA.pm176
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/SPF.pm48
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/SRV.pm151
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/SSHFP.pm219
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/TKEY.pm208
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/TSIG.pm353
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/TXT.pm179
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/Unknown.pm82
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/X25.pm95
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/Resolver.pm750
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/Resolver/Base.pm1579
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/Resolver/Cygwin.pm180
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/Resolver/Recurse.pm485
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/Resolver/UNIX.pm74
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/Resolver/Win32.pm225
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/Update.pm200
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/PadWalker.pm154
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Proc/Killall.pm111
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Proc/Killfam.pm83
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Proc/ProcessTable.pm232
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Proc/ProcessTable/Process.pm182
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Proc/example.pl16
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Term/ReadKey.pm564
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Term/ReadLine/Gnu.pm1921
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Term/ReadLine/Gnu/XS.pm590
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML.pm1778
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML.pod433
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/Attr.pod130
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/Boolean.pm85
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/CDATASection.pod54
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/Comment.pod55
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/Common.pm306
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/DOM.pod139
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/Document.pod675
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/DocumentFragment.pod36
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/Dtd.pod98
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/Element.pod380
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/InputCallback.pod288
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/Literal.pm102
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/Namespace.pod139
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/Node.pod661
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/NodeList.pm191
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/Number.pm90
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/PI.pod83
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/Parser.pod683
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/Reader.pm222
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/Reader.pod716
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/RelaxNG.pod77
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/SAX.pm81
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/SAX.pod46
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/SAX/Builder.pm322
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/SAX/Builder.pod47
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/SAX/Generator.pm146
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/SAX/Parser.pm254
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/Schema.pod73
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/Text.pod179
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/XPathContext.pm131
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/XPathContext.pod349
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/Parser.pm840
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/Parser/Encodings/Japanese_Encodings.msg117
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/Parser/Encodings/README51
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/Parser/Encodings/big5.encbin40706 -> 0 bytes
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/Parser/Encodings/euc-kr.encbin45802 -> 0 bytes
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/Parser/Encodings/iso-8859-2.encbin1072 -> 0 bytes
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/Parser/Encodings/iso-8859-3.encbin1072 -> 0 bytes
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/Parser/Encodings/iso-8859-4.encbin1072 -> 0 bytes
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/Parser/Encodings/iso-8859-5.encbin1072 -> 0 bytes
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/Parser/Encodings/iso-8859-7.encbin1072 -> 0 bytes
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/Parser/Encodings/iso-8859-8.encbin1072 -> 0 bytes
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/Parser/Encodings/iso-8859-9.encbin1072 -> 0 bytes
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/Parser/Encodings/windows-1250.encbin1072 -> 0 bytes
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/Parser/Encodings/windows-1252.encbin1072 -> 0 bytes
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/Parser/Encodings/x-euc-jp-jisx0221.encbin37890 -> 0 bytes
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/Parser/Encodings/x-euc-jp-unicode.encbin37890 -> 0 bytes
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/Parser/Encodings/x-sjis-cp932.encbin20368 -> 0 bytes
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/Parser/Encodings/x-sjis-jdk117.encbin18202 -> 0 bytes
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/Parser/Encodings/x-sjis-jisx0221.encbin18202 -> 0 bytes
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/Parser/Encodings/x-sjis-unicode.encbin18202 -> 0 bytes
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/Parser/Expat.pm1230
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/Parser/LWPExternEnt.pl71
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/Parser/Style/Debug.pm52
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/Parser/Style/Objects.pm78
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/Parser/Style/Stream.pm184
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/Parser/Style/Subs.pm58
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/Parser/Style/Tree.pm90
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Alias/.packlist2
-rwxr-xr-xchromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Alias/Alias.dllbin26896 -> 0 bytes
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Archive/Zip/.packlist14
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/CPAN/.packlist15
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/CPAN/Reporter/.packlist10
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Compress/Bzip2/.packlist3
-rwxr-xr-xchromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Compress/Bzip2/Bzip2.dllbin95624 -> 0 bytes
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Compress/Bzip2/autosplit.ix3
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Compress/Raw/Bzip2/.packlist3
-rwxr-xr-xchromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Compress/Raw/Bzip2/Bzip2.dllbin109141 -> 0 bytes
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Compress/Raw/Bzip2/autosplit.ix3
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Config/Tiny/.packlist1
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Cwd/.packlist11
-rwxr-xr-xchromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Cwd/Cwd.dllbin23962 -> 0 bytes
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Devel/Symdump/.packlist2
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Digest/SHA/.packlist3
-rwxr-xr-xchromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Digest/SHA/SHA.dllbin77883 -> 0 bytes
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/File/Copy/Recursive/.packlist1
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/File/HomeDir/.packlist6
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/File/Temp/.packlist2
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/File/pushd/.packlist2
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/HTML/Parser/.packlist8
-rwxr-xr-xchromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/HTML/Parser/Parser.dllbin69244 -> 0 bytes
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/HTML/Tagset/.packlist1
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/IO/CaptureOutput/.packlist2
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/IO/Compress/Bzip2/.packlist4
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/IO/String/.packlist1
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/IPC/Run3/.packlist6
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/LWP/.packlist54
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Math/BigInt/FastCalc/.packlist2
-rwxr-xr-xchromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Math/BigInt/FastCalc/FastCalc.dllbin36372 -> 0 bytes
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Module/ScanDeps/.packlist3
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Module/Signature/.packlist2
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Net/DNS/.packlist50
-rwxr-xr-xchromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Net/DNS/DNS.dllbin19383 -> 0 bytes
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Net/Telnet/.packlist1
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/PAR/Dist/.packlist1
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/PadWalker/.packlist2
-rwxr-xr-xchromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/PadWalker/PadWalker.dllbin34568 -> 0 bytes
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Pod/Coverage/.packlist5
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Pod/Escapes/.packlist1
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Pod/Simple/.packlist31
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Probe/Perl/.packlist1
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Proc/ProcessTable/.packlist7
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Proc/ProcessTable/Process/autosplit.ix3
-rwxr-xr-xchromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Proc/ProcessTable/ProcessTable.dllbin38168 -> 0 bytes
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Tee/.packlist4
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Term/ReadKey/.packlist3
-rwxr-xr-xchromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Term/ReadKey/ReadKey.dllbin45028 -> 0 bytes
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Term/ReadKey/autosplit.ix3
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Term/ReadLine/.packlist2
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Term/ReadLine/Gnu/.packlist4
-rwxr-xr-xchromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Term/ReadLine/Gnu/Gnu.dllbin247061 -> 0 bytes
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Term/ReadLine/Gnu/XS/autosplit.ix3
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Test/Pod/.packlist1
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Test/Pod/Coverage/.packlist1
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Test/Reporter/.packlist8
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/URI/.packlist49
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/XML/LibXML/.packlist33
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/XML/LibXML/Common/.packlist2
-rwxr-xr-xchromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/XML/LibXML/Common/Common.dllbin25870 -> 0 bytes
-rwxr-xr-xchromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/XML/LibXML/LibXML.dllbin548353 -> 0 bytes
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/XML/NamespaceSupport/.packlist1
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/XML/Parser/.packlist28
-rwxr-xr-xchromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/XML/Parser/Expat/Expat.dllbin125467 -> 0 bytes
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/XML/SAX/.packlist23
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/YAML/.packlist13
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/lwpcook.pod309
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/lwptut.pod837
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/perlpod.pod685
-rw-r--r--chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/perlpodspec.pod1876
467 files changed, 0 insertions, 141405 deletions
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Archive/Zip.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Archive/Zip.pm
deleted file mode 100644
index 0211170e504..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Archive/Zip.pm
+++ /dev/null
@@ -1,2029 +0,0 @@
-package Archive::Zip;
-
-use strict;
-BEGIN {
- require 5.003_96;
-}
-use UNIVERSAL ();
-use Carp ();
-use IO::File ();
-use IO::Seekable ();
-use Compress::Zlib ();
-use File::Spec ();
-use File::Temp ();
-
-use vars qw( $VERSION @ISA );
-BEGIN {
- $VERSION = '1.23';
-
- require Exporter;
- @ISA = qw( Exporter );
-}
-
-use vars qw( $ChunkSize $ErrorHandler );
-BEGIN {
- # This is the size we'll try to read, write, and (de)compress.
- # You could set it to something different if you had lots of memory
- # and needed more speed.
- $ChunkSize ||= 32768;
-
- $ErrorHandler = \&Carp::carp;
-}
-
-# BEGIN block is necessary here so that other modules can use the constants.
-use vars qw( @EXPORT_OK %EXPORT_TAGS );
-BEGIN {
- @EXPORT_OK = ('computeCRC32');
- %EXPORT_TAGS = (
- CONSTANTS => [ qw(
- FA_MSDOS
- FA_UNIX
- GPBF_ENCRYPTED_MASK
- GPBF_DEFLATING_COMPRESSION_MASK
- GPBF_HAS_DATA_DESCRIPTOR_MASK
- COMPRESSION_STORED
- COMPRESSION_DEFLATED
- COMPRESSION_LEVEL_NONE
- COMPRESSION_LEVEL_DEFAULT
- COMPRESSION_LEVEL_FASTEST
- COMPRESSION_LEVEL_BEST_COMPRESSION
- IFA_TEXT_FILE_MASK
- IFA_TEXT_FILE
- IFA_BINARY_FILE
- ) ],
-
- MISC_CONSTANTS => [ qw(
- FA_AMIGA
- FA_VAX_VMS
- FA_VM_CMS
- FA_ATARI_ST
- FA_OS2_HPFS
- FA_MACINTOSH
- FA_Z_SYSTEM
- FA_CPM
- FA_TOPS20
- FA_WINDOWS_NTFS
- FA_QDOS
- FA_ACORN
- FA_VFAT
- FA_MVS
- FA_BEOS
- FA_TANDEM
- FA_THEOS
- GPBF_IMPLODING_8K_SLIDING_DICTIONARY_MASK
- GPBF_IMPLODING_3_SHANNON_FANO_TREES_MASK
- GPBF_IS_COMPRESSED_PATCHED_DATA_MASK
- COMPRESSION_SHRUNK
- DEFLATING_COMPRESSION_NORMAL
- DEFLATING_COMPRESSION_MAXIMUM
- DEFLATING_COMPRESSION_FAST
- DEFLATING_COMPRESSION_SUPER_FAST
- COMPRESSION_REDUCED_1
- COMPRESSION_REDUCED_2
- COMPRESSION_REDUCED_3
- COMPRESSION_REDUCED_4
- COMPRESSION_IMPLODED
- COMPRESSION_TOKENIZED
- COMPRESSION_DEFLATED_ENHANCED
- COMPRESSION_PKWARE_DATA_COMPRESSION_LIBRARY_IMPLODED
- ) ],
-
- ERROR_CODES => [ qw(
- AZ_OK
- AZ_STREAM_END
- AZ_ERROR
- AZ_FORMAT_ERROR
- AZ_IO_ERROR
- ) ],
-
- # For Internal Use Only
- PKZIP_CONSTANTS => [ qw(
- SIGNATURE_FORMAT
- SIGNATURE_LENGTH
- LOCAL_FILE_HEADER_SIGNATURE
- LOCAL_FILE_HEADER_FORMAT
- LOCAL_FILE_HEADER_LENGTH
- CENTRAL_DIRECTORY_FILE_HEADER_SIGNATURE
- DATA_DESCRIPTOR_FORMAT
- DATA_DESCRIPTOR_LENGTH
- DATA_DESCRIPTOR_SIGNATURE
- DATA_DESCRIPTOR_FORMAT_NO_SIG
- DATA_DESCRIPTOR_LENGTH_NO_SIG
- CENTRAL_DIRECTORY_FILE_HEADER_FORMAT
- CENTRAL_DIRECTORY_FILE_HEADER_LENGTH
- END_OF_CENTRAL_DIRECTORY_SIGNATURE
- END_OF_CENTRAL_DIRECTORY_SIGNATURE_STRING
- END_OF_CENTRAL_DIRECTORY_FORMAT
- END_OF_CENTRAL_DIRECTORY_LENGTH
- ) ],
-
- # For Internal Use Only
- UTILITY_METHODS => [ qw(
- _error
- _printError
- _ioError
- _formatError
- _subclassResponsibility
- _binmode
- _isSeekable
- _newFileHandle
- _readSignature
- _asZipDirName
- ) ],
- );
-
- # Add all the constant names and error code names to @EXPORT_OK
- Exporter::export_ok_tags( qw(
- CONSTANTS
- ERROR_CODES
- PKZIP_CONSTANTS
- UTILITY_METHODS
- MISC_CONSTANTS
- ) );
-
-}
-
-# Error codes
-use constant AZ_OK => 0;
-use constant AZ_STREAM_END => 1;
-use constant AZ_ERROR => 2;
-use constant AZ_FORMAT_ERROR => 3;
-use constant AZ_IO_ERROR => 4;
-
-# File types
-# Values of Archive::Zip::Member->fileAttributeFormat()
-
-use constant FA_MSDOS => 0;
-use constant FA_AMIGA => 1;
-use constant FA_VAX_VMS => 2;
-use constant FA_UNIX => 3;
-use constant FA_VM_CMS => 4;
-use constant FA_ATARI_ST => 5;
-use constant FA_OS2_HPFS => 6;
-use constant FA_MACINTOSH => 7;
-use constant FA_Z_SYSTEM => 8;
-use constant FA_CPM => 9;
-use constant FA_TOPS20 => 10;
-use constant FA_WINDOWS_NTFS => 11;
-use constant FA_QDOS => 12;
-use constant FA_ACORN => 13;
-use constant FA_VFAT => 14;
-use constant FA_MVS => 15;
-use constant FA_BEOS => 16;
-use constant FA_TANDEM => 17;
-use constant FA_THEOS => 18;
-
-# general-purpose bit flag masks
-# Found in Archive::Zip::Member->bitFlag()
-
-use constant GPBF_ENCRYPTED_MASK => 1 << 0;
-use constant GPBF_DEFLATING_COMPRESSION_MASK => 3 << 1;
-use constant GPBF_HAS_DATA_DESCRIPTOR_MASK => 1 << 3;
-
-# deflating compression types, if compressionMethod == COMPRESSION_DEFLATED
-# ( Archive::Zip::Member->bitFlag() & GPBF_DEFLATING_COMPRESSION_MASK )
-
-use constant DEFLATING_COMPRESSION_NORMAL => 0 << 1;
-use constant DEFLATING_COMPRESSION_MAXIMUM => 1 << 1;
-use constant DEFLATING_COMPRESSION_FAST => 2 << 1;
-use constant DEFLATING_COMPRESSION_SUPER_FAST => 3 << 1;
-
-# compression method
-
-# these two are the only ones supported in this module
-use constant COMPRESSION_STORED => 0; # file is stored (no compression)
-use constant COMPRESSION_DEFLATED => 8; # file is Deflated
-use constant COMPRESSION_LEVEL_NONE => 0;
-use constant COMPRESSION_LEVEL_DEFAULT => -1;
-use constant COMPRESSION_LEVEL_FASTEST => 1;
-use constant COMPRESSION_LEVEL_BEST_COMPRESSION => 9;
-
-# internal file attribute bits
-# Found in Archive::Zip::Member::internalFileAttributes()
-
-use constant IFA_TEXT_FILE_MASK => 1;
-use constant IFA_TEXT_FILE => 1;
-use constant IFA_BINARY_FILE => 0;
-
-# PKZIP file format miscellaneous constants (for internal use only)
-use constant SIGNATURE_FORMAT => "V";
-use constant SIGNATURE_LENGTH => 4;
-
-# these lengths are without the signature.
-use constant LOCAL_FILE_HEADER_SIGNATURE => 0x04034b50;
-use constant LOCAL_FILE_HEADER_FORMAT => "v3 V4 v2";
-use constant LOCAL_FILE_HEADER_LENGTH => 26;
-
-# PKZIP docs don't mention the signature, but Info-Zip writes it.
-use constant DATA_DESCRIPTOR_SIGNATURE => 0x08074b50;
-use constant DATA_DESCRIPTOR_FORMAT => "V3";
-use constant DATA_DESCRIPTOR_LENGTH => 12;
-
-# but the signature is apparently optional.
-use constant DATA_DESCRIPTOR_FORMAT_NO_SIG => "V2";
-use constant DATA_DESCRIPTOR_LENGTH_NO_SIG => 8;
-
-use constant CENTRAL_DIRECTORY_FILE_HEADER_SIGNATURE => 0x02014b50;
-use constant CENTRAL_DIRECTORY_FILE_HEADER_FORMAT => "C2 v3 V4 v5 V2";
-use constant CENTRAL_DIRECTORY_FILE_HEADER_LENGTH => 42;
-
-use constant END_OF_CENTRAL_DIRECTORY_SIGNATURE => 0x06054b50;
-use constant END_OF_CENTRAL_DIRECTORY_SIGNATURE_STRING =>
- pack( "V", END_OF_CENTRAL_DIRECTORY_SIGNATURE );
-use constant END_OF_CENTRAL_DIRECTORY_FORMAT => "v4 V2 v";
-use constant END_OF_CENTRAL_DIRECTORY_LENGTH => 18;
-
-use constant GPBF_IMPLODING_8K_SLIDING_DICTIONARY_MASK => 1 << 1;
-use constant GPBF_IMPLODING_3_SHANNON_FANO_TREES_MASK => 1 << 2;
-use constant GPBF_IS_COMPRESSED_PATCHED_DATA_MASK => 1 << 5;
-
-# the rest of these are not supported in this module
-use constant COMPRESSION_SHRUNK => 1; # file is Shrunk
-use constant COMPRESSION_REDUCED_1 => 2; # file is Reduced CF=1
-use constant COMPRESSION_REDUCED_2 => 3; # file is Reduced CF=2
-use constant COMPRESSION_REDUCED_3 => 4; # file is Reduced CF=3
-use constant COMPRESSION_REDUCED_4 => 5; # file is Reduced CF=4
-use constant COMPRESSION_IMPLODED => 6; # file is Imploded
-use constant COMPRESSION_TOKENIZED => 7; # reserved for Tokenizing compr.
-use constant COMPRESSION_DEFLATED_ENHANCED => 9; # reserved for enh. Deflating
-use constant COMPRESSION_PKWARE_DATA_COMPRESSION_LIBRARY_IMPLODED => 10;
-
-# Load the various required classes
-require Archive::Zip::Archive;
-require Archive::Zip::Member;
-require Archive::Zip::FileMember;
-require Archive::Zip::DirectoryMember;
-require Archive::Zip::ZipFileMember;
-require Archive::Zip::NewFileMember;
-require Archive::Zip::StringMember;
-
-use constant ZIPARCHIVECLASS => 'Archive::Zip::Archive';
-use constant ZIPMEMBERCLASS => 'Archive::Zip::Member';
-
-# Convenience functions
-
-sub _ISA ($$) {
- # Can't rely on Scalar::Util, so use the next best way
- !! eval { ref $_[0] and $_[0]->isa($_[1]) };
-}
-
-sub _CAN ($$) {
- !! eval { ref $_[0] and $_[0]->can($_[1]) };
-}
-
-
-
-
-
-#####################################################################
-# Methods
-
-sub new {
- my $class = shift;
- return $class->ZIPARCHIVECLASS->new(@_);
-}
-
-sub computeCRC32 {
- my $data = shift;
- $data = shift if ref($data); # allow calling as an obj method
- my $crc = shift;
- return Compress::Zlib::crc32( $data, $crc );
-}
-
-# Report or change chunk size used for reading and writing.
-# Also sets Zlib's default buffer size (eventually).
-sub setChunkSize {
- my $chunkSize = shift;
- $chunkSize = shift if ref($chunkSize); # object method on zip?
- my $oldChunkSize = $Archive::Zip::ChunkSize;
- $Archive::Zip::ChunkSize = $chunkSize if ($chunkSize);
- return $oldChunkSize;
-}
-
-sub chunkSize {
- return $Archive::Zip::ChunkSize;
-}
-
-sub setErrorHandler (&) {
- my $errorHandler = shift;
- $errorHandler = \&Carp::carp unless defined($errorHandler);
- my $oldErrorHandler = $Archive::Zip::ErrorHandler;
- $Archive::Zip::ErrorHandler = $errorHandler;
- return $oldErrorHandler;
-}
-
-
-
-
-
-######################################################################
-# Private utility functions (not methods).
-
-sub _printError {
- my $string = join ( ' ', @_, "\n" );
- my $oldCarpLevel = $Carp::CarpLevel;
- $Carp::CarpLevel += 2;
- &{$ErrorHandler} ($string);
- $Carp::CarpLevel = $oldCarpLevel;
-}
-
-# This is called on format errors.
-sub _formatError {
- shift if ref( $_[0] );
- _printError( 'format error:', @_ );
- return AZ_FORMAT_ERROR;
-}
-
-# This is called on IO errors.
-sub _ioError {
- shift if ref( $_[0] );
- _printError( 'IO error:', @_, ':', $! );
- return AZ_IO_ERROR;
-}
-
-# This is called on generic errors.
-sub _error {
- shift if ref( $_[0] );
- _printError( 'error:', @_ );
- return AZ_ERROR;
-}
-
-# Called when a subclass should have implemented
-# something but didn't
-sub _subclassResponsibility {
- Carp::croak("subclass Responsibility\n");
-}
-
-# Try to set the given file handle or object into binary mode.
-sub _binmode {
- my $fh = shift;
- return _CAN( $fh, 'binmode' ) ? $fh->binmode() : binmode($fh);
-}
-
-# Attempt to guess whether file handle is seekable.
-# Because of problems with Windows, this only returns true when
-# the file handle is a real file.
-sub _isSeekable {
- my $fh = shift;
- return 0 unless ref $fh;
- if ( _ISA($fh, 'IO::Scalar') ) {
- # IO::Scalar objects are brokenly-seekable
- return 0;
- }
- if ( _ISA($fh, 'IO::String') ) {
- return 1;
- }
- if ( _ISA($fh, 'IO::Seekable') ) {
- # Unfortunately, some things like FileHandle objects
- # return true for Seekable, but AREN'T!!!!!
- if ( _ISA($fh, 'FileHandle') ) {
- return 0;
- } else {
- return 1;
- }
- }
- if ( _CAN($fh, 'stat') ) {
- return -f $fh;
- }
- return (
- _CAN($fh, 'seek') and _CAN($fh, 'tell')
- ) ? 1 : 0;
-}
-
-# Return an opened IO::Handle
-# my ( $status, fh ) = _newFileHandle( 'fileName', 'w' );
-# Can take a filename, file handle, or ref to GLOB
-# Or, if given something that is a ref but not an IO::Handle,
-# passes back the same thing.
-sub _newFileHandle {
- my $fd = shift;
- my $status = 1;
- my $handle;
-
- if ( ref($fd) ) {
- if ( _ISA($fd, 'IO::Scalar') or _ISA($fd, 'IO::String') ) {
- $handle = $fd;
- } elsif ( _ISA($fd, 'IO::Handle') or ref($fd) eq 'GLOB' ) {
- $handle = IO::File->new();
- $status = $handle->fdopen( $fd, @_ );
- } else {
- $handle = $fd;
- }
- } else {
- $handle = IO::File->new();
- $status = $handle->open( $fd, @_ );
- }
-
- return ( $status, $handle );
-}
-
-# Returns next signature from given file handle, leaves
-# file handle positioned afterwards.
-# In list context, returns ($status, $signature)
-# ( $status, $signature) = _readSignature( $fh, $fileName );
-
-sub _readSignature {
- my $fh = shift;
- my $fileName = shift;
- my $expectedSignature = shift; # optional
-
- my $signatureData;
- my $bytesRead = $fh->read( $signatureData, SIGNATURE_LENGTH );
- if ( $bytesRead != SIGNATURE_LENGTH ) {
- return _ioError("reading header signature");
- }
- my $signature = unpack( SIGNATURE_FORMAT, $signatureData );
- my $status = AZ_OK;
-
- # compare with expected signature, if any, or any known signature.
- if ( ( defined($expectedSignature) && $signature != $expectedSignature )
- || ( !defined($expectedSignature)
- && $signature != CENTRAL_DIRECTORY_FILE_HEADER_SIGNATURE
- && $signature != LOCAL_FILE_HEADER_SIGNATURE
- && $signature != END_OF_CENTRAL_DIRECTORY_SIGNATURE
- && $signature != DATA_DESCRIPTOR_SIGNATURE ) )
- {
- my $errmsg = sprintf( "bad signature: 0x%08x", $signature );
- if ( _isSeekable($fh) )
- {
- $errmsg .=
- sprintf( " at offset %d", $fh->tell() - SIGNATURE_LENGTH );
- }
-
- $status = _formatError("$errmsg in file $fileName");
- }
-
- return ( $status, $signature );
-}
-
-# Utility method to make and open a temp file.
-# Will create $temp_dir if it doesn't exist.
-# Returns file handle and name:
-#
-# my ($fh, $name) = Archive::Zip::tempFile();
-# my ($fh, $name) = Archive::Zip::tempFile('mytempdir');
-#
-
-sub tempFile {
- my $dir = shift;
- my ( $fh, $filename ) = File::Temp::tempfile(
- SUFFIX => '.zip',
- UNLINK => 0, # we will delete it!
- $dir ? ( DIR => $dir ) : ()
- );
- return ( undef, undef ) unless $fh;
- my ( $status, $newfh ) = _newFileHandle( $fh, 'w+' );
- return ( $newfh, $filename );
-}
-
-# Return the normalized directory name as used in a zip file (path
-# separators become slashes, etc.).
-# Will translate internal slashes in path components (i.e. on Macs) to
-# underscores. Discards volume names.
-# When $forceDir is set, returns paths with trailing slashes (or arrays
-# with trailing blank members).
-#
-# If third argument is a reference, returns volume information there.
-#
-# input output
-# . ('.') '.'
-# ./a ('a') a
-# ./a/b ('a','b') a/b
-# ./a/b/ ('a','b') a/b
-# a/b/ ('a','b') a/b
-# /a/b/ ('','a','b') /a/b
-# c:\a\b\c.doc ('','a','b','c.doc') /a/b/c.doc # on Windoze
-# "i/o maps:whatever" ('i_o maps', 'whatever') "i_o maps/whatever" # on Macs
-sub _asZipDirName
-{
- my $name = shift;
- my $forceDir = shift;
- my $volReturn = shift;
- my ( $volume, $directories, $file ) =
- File::Spec->splitpath( File::Spec->canonpath($name), $forceDir );
- $$volReturn = $volume if ( ref($volReturn) );
- my @dirs = map { $_ =~ s{/}{_}g; $_ } File::Spec->splitdir($directories);
- if ( @dirs > 0 ) { pop (@dirs) unless $dirs[-1] } # remove empty component
- push ( @dirs, defined($file) ? $file : '' );
- #return wantarray ? @dirs : join ( '/', @dirs );
- return join ( '/', @dirs );
-}
-
-# Return an absolute local name for a zip name.
-# Assume a directory if zip name has trailing slash.
-# Takes an optional volume name in FS format (like 'a:').
-#
-sub _asLocalName
-{
- my $name = shift; # zip format
- my $volume = shift;
- $volume = '' unless defined($volume); # local FS format
-
- my @paths = split ( /\//, $name );
- my $filename = pop (@paths);
- $filename = '' unless defined($filename);
- my $localDirs = @paths?File::Spec->catdir(@paths):'';
- my $localName = File::Spec->catpath( $volume, $localDirs, $filename );
- $localName = File::Spec->rel2abs($localName) unless $volume;
- return $localName;
-}
-
-1;
-
-__END__
-
-=pod
-
-=head1 NAME
-
-Archive::Zip - Provide an interface to ZIP archive files.
-
-=head1 SYNOPSIS
-
- # Create a Zip file
- use Archive::Zip qw( :ERROR_CODES :CONSTANTS );
- my $zip = Archive::Zip->new();
-
- # Add a directory
- my $dir_member = $zip->addDirectory( 'dirname/' );
-
- # Add a file from a string with compression
- my $string_member = $zip->addString( 'This is a test', 'stringMember.txt' );
- $string_member->desiredCompressionMethod( COMPRESSION_DEFLATED );
-
- # Add a file from disk
- my $file_member = $zip->addFile( 'xyz.pl', 'AnotherName.pl' );
-
- # Save the Zip file
- unless ( $zip->writeToFileNamed('someZip.zip') == AZ_OK ) {
- die 'write error';
- }
-
- # Read a Zip file
- my $somezip = Archive::Zip->new();
- unless ( $somezip->read( 'someZip.zip' ) == AZ_OK ) {
- die 'read error';
- }
-
- # Change the compression type for a file in the Zip
- my $member = $somezip->memberNamed( 'stringMember.txt' );
- $member->desiredCompressionMethod( COMPRESSION_STORED );
- unless ( $zip->writeToFileNamed( 'someOtherZip.zip' ) == AZ_OK ) {
- die 'write error';
- }
-
-=head1 DESCRIPTION
-
-The Archive::Zip module allows a Perl program to create, manipulate, read,
-and write Zip archive files.
-
-Zip archives can be created, or you can read from existing zip files.
-
-Once created, they can be written to files, streams, or strings. Members
-can be added, removed, extracted, replaced, rearranged, and enumerated.
-They can also be renamed or have their dates, comments, or other attributes
-queried or modified. Their data can be compressed or uncompressed as needed.
-
-Members can be created from members in existing Zip files, or from existing
-directories, files, or strings.
-
-This module uses the L<Compress::Zlib> library to read and write the
-compressed streams inside the files.
-
-=head2 File Naming
-
-Regardless of what your local file system uses for file naming, names in a
-Zip file are in Unix format (I<forward> slashes (/) separating directory
-names, etc.).
-
-C<Archive::Zip> tries to be consistent with file naming conventions, and will
-translate back and forth between native and Zip file names.
-
-However, it can't guess which format names are in. So two rules control what
-kind of file name you must pass various routines:
-
-=over 4
-
-=item Names of files are in local format.
-
-C<File::Spec> and C<File::Basename> are used for various file
-operations. When you're referring to a file on your system, use its
-file naming conventions.
-
-=item Names of archive members are in Unix format.
-
-This applies to every method that refers to an archive member, or
-provides a name for new archive members. The C<extract()> methods
-that can take one or two names will convert from local to zip names
-if you call them with a single name.
-
-=back
-
-=head2 Archive::Zip Object Model
-
-=head2 Overview
-
-Archive::Zip::Archive objects are what you ordinarily deal with.
-These maintain the structure of a zip file, without necessarily
-holding data. When a zip is read from a disk file, the (possibly
-compressed) data still lives in the file, not in memory. Archive
-members hold information about the individual members, but not
-(usually) the actual member data. When the zip is written to a
-(different) file, the member data is compressed or copied as needed.
-It is possible to make archive members whose data is held in a string
-in memory, but this is not done when a zip file is read. Directory
-members don't have any data.
-
-=head2 Inheritance
-
- Exporter
- Archive::Zip Common base class, has defs.
- Archive::Zip::Archive A Zip archive.
- Archive::Zip::Member Abstract superclass for all members.
- Archive::Zip::StringMember Member made from a string
- Archive::Zip::FileMember Member made from an external file
- Archive::Zip::ZipFileMember Member that lives in a zip file
- Archive::Zip::NewFileMember Member whose data is in a file
- Archive::Zip::DirectoryMember Member that is a directory
-
-=head1 EXPORTS
-
-=over 4
-
-=item :CONSTANTS
-
-Exports the following constants:
-
-FA_MSDOS FA_UNIX GPBF_ENCRYPTED_MASK
-GPBF_DEFLATING_COMPRESSION_MASK GPBF_HAS_DATA_DESCRIPTOR_MASK
-COMPRESSION_STORED COMPRESSION_DEFLATED IFA_TEXT_FILE_MASK
-IFA_TEXT_FILE IFA_BINARY_FILE COMPRESSION_LEVEL_NONE
-COMPRESSION_LEVEL_DEFAULT COMPRESSION_LEVEL_FASTEST
-COMPRESSION_LEVEL_BEST_COMPRESSION
-
-=item :MISC_CONSTANTS
-
-Exports the following constants (only necessary for extending the
-module):
-
-FA_AMIGA FA_VAX_VMS FA_VM_CMS FA_ATARI_ST FA_OS2_HPFS
-FA_MACINTOSH FA_Z_SYSTEM FA_CPM FA_WINDOWS_NTFS
-GPBF_IMPLODING_8K_SLIDING_DICTIONARY_MASK
-GPBF_IMPLODING_3_SHANNON_FANO_TREES_MASK
-GPBF_IS_COMPRESSED_PATCHED_DATA_MASK COMPRESSION_SHRUNK
-DEFLATING_COMPRESSION_NORMAL DEFLATING_COMPRESSION_MAXIMUM
-DEFLATING_COMPRESSION_FAST DEFLATING_COMPRESSION_SUPER_FAST
-COMPRESSION_REDUCED_1 COMPRESSION_REDUCED_2 COMPRESSION_REDUCED_3
-COMPRESSION_REDUCED_4 COMPRESSION_IMPLODED COMPRESSION_TOKENIZED
-COMPRESSION_DEFLATED_ENHANCED
-COMPRESSION_PKWARE_DATA_COMPRESSION_LIBRARY_IMPLODED
-
-=item :ERROR_CODES
-
-Explained below. Returned from most methods.
-
-AZ_OK AZ_STREAM_END AZ_ERROR AZ_FORMAT_ERROR AZ_IO_ERROR
-
-=back
-
-=head1 ERROR CODES
-
-Many of the methods in Archive::Zip return error codes. These are implemented
-as inline subroutines, using the C<use constant> pragma. They can be imported
-into your namespace using the C<:ERROR_CODES> tag:
-
- use Archive::Zip qw( :ERROR_CODES );
-
- ...
-
- unless ( $zip->read( 'myfile.zip' ) == AZ_OK ) {
- die "whoops!";
- }
-
-=over 4
-
-=item AZ_OK (0)
-
-Everything is fine.
-
-=item AZ_STREAM_END (1)
-
-The read stream (or central directory) ended normally.
-
-=item AZ_ERROR (2)
-
-There was some generic kind of error.
-
-=item AZ_FORMAT_ERROR (3)
-
-There is a format error in a ZIP file being read.
-
-=item AZ_IO_ERROR (4)
-
-There was an IO error.
-
-=back
-
-=head2 Compression
-
-Archive::Zip allows each member of a ZIP file to be compressed (using the
-Deflate algorithm) or uncompressed.
-
-Other compression algorithms that some versions of ZIP have been able to
-produce are not supported. Each member has two compression methods: the
-one it's stored as (this is always COMPRESSION_STORED for string and external
-file members), and the one you desire for the member in the zip file.
-
-These can be different, of course, so you can make a zip member that is not
-compressed out of one that is, and vice versa.
-
-You can inquire about the current compression and set the desired
-compression method:
-
- my $member = $zip->memberNamed( 'xyz.txt' );
- $member->compressionMethod(); # return current compression
-
- # set to read uncompressed
- $member->desiredCompressionMethod( COMPRESSION_STORED );
-
- # set to read compressed
- $member->desiredCompressionMethod( COMPRESSION_DEFLATED );
-
-There are two different compression methods:
-
-=over 4
-
-=item COMPRESSION_STORED
-
-File is stored (no compression)
-
-=item COMPRESSION_DEFLATED
-
-File is Deflated
-
-=back
-
-=head2 Compression Levels
-
-If a member's desiredCompressionMethod is COMPRESSION_DEFLATED, you
-can choose different compression levels. This choice may affect the
-speed of compression and decompression, as well as the size of the
-compressed member data.
-
- $member->desiredCompressionLevel( 9 );
-
-The levels given can be:
-
-=over 4
-
-=item 0 or COMPRESSION_LEVEL_NONE
-
-This is the same as saying
-
- $member->desiredCompressionMethod( COMPRESSION_STORED );
-
-=item 1 .. 9
-
-1 gives the best speed and worst compression, and 9 gives the
-best compression and worst speed.
-
-=item COMPRESSION_LEVEL_FASTEST
-
-This is a synonym for level 1.
-
-=item COMPRESSION_LEVEL_BEST_COMPRESSION
-
-This is a synonym for level 9.
-
-=item COMPRESSION_LEVEL_DEFAULT
-
-This gives a good compromise between speed and compression,
-and is currently equivalent to 6 (this is in the zlib code).
-This is the level that will be used if not specified.
-
-=back
-
-=head1 Archive::Zip Methods
-
-The Archive::Zip class (and its invisible subclass Archive::Zip::Archive)
-implement generic zip file functionality. Creating a new Archive::Zip object
-actually makes an Archive::Zip::Archive object, but you don't have to worry
-about this unless you're subclassing.
-
-=head2 Constructor
-
-=over 4
-
-=item new( [$fileName] )
-
-Make a new, empty zip archive.
-
- my $zip = Archive::Zip->new();
-
-If an additional argument is passed, new() will call read()
-to read the contents of an archive:
-
- my $zip = Archive::Zip->new( 'xyz.zip' );
-
-If a filename argument is passed and the read fails for any
-reason, new will return undef. For this reason, it may be
-better to call read separately.
-
-=back
-
-=head2 Zip Archive Utility Methods
-
-These Archive::Zip methods may be called as functions or as object
-methods. Do not call them as class methods:
-
- $zip = Archive::Zip->new();
- $crc = Archive::Zip::computeCRC32( 'ghijkl' ); # OK
- $crc = $zip->computeCRC32( 'ghijkl' ); # also OK
- $crc = Archive::Zip->computeCRC32( 'ghijkl' ); # NOT OK
-
-=over 4
-
-=item Archive::Zip::computeCRC32( $string [, $crc] )
-
-This is a utility function that uses the Compress::Zlib CRC
-routine to compute a CRC-32. You can get the CRC of a string:
-
- $crc = Archive::Zip::computeCRC32( $string );
-
-Or you can compute the running CRC:
-
- $crc = 0;
- $crc = Archive::Zip::computeCRC32( 'abcdef', $crc );
- $crc = Archive::Zip::computeCRC32( 'ghijkl', $crc );
-
-=item Archive::Zip::setChunkSize( $number )
-
-Report or change chunk size used for reading and writing.
-This can make big differences in dealing with large files.
-Currently, this defaults to 32K. This also changes the chunk
-size used for Compress::Zlib. You must call setChunkSize()
-before reading or writing. This is not exportable, so you
-must call it like:
-
- Archive::Zip::setChunkSize( 4096 );
-
-or as a method on a zip (though this is a global setting).
-Returns old chunk size.
-
-=item Archive::Zip::chunkSize()
-
-Returns the current chunk size:
-
- my $chunkSize = Archive::Zip::chunkSize();
-
-=item Archive::Zip::setErrorHandler( \&subroutine )
-
-Change the subroutine called with error strings. This
-defaults to \&Carp::carp, but you may want to change it to
-get the error strings. This is not exportable, so you must
-call it like:
-
- Archive::Zip::setErrorHandler( \&myErrorHandler );
-
-If myErrorHandler is undef, resets handler to default.
-Returns old error handler. Note that if you call Carp::carp
-or a similar routine or if you're chaining to the default
-error handler from your error handler, you may want to
-increment the number of caller levels that are skipped (do
-not just set it to a number):
-
- $Carp::CarpLevel++;
-
-=item Archive::Zip::tempFile( [$tmpdir] )
-
-Create a uniquely named temp file. It will be returned open
-for read/write. If C<$tmpdir> is given, it is used as the
-name of a directory to create the file in. If not given,
-creates the file using C<File::Spec::tmpdir()>. Generally, you can
-override this choice using the
-
- $ENV{TMPDIR}
-
-environment variable. But see the L<File::Spec|File::Spec>
-documentation for your system. Note that on many systems, if you're
-running in taint mode, then you must make sure that C<$ENV{TMPDIR}> is
-untainted for it to be used.
-Will I<NOT> create C<$tmpdir> if it doesn't exist (this is a change
-from prior versions!). Returns file handle and name:
-
- my ($fh, $name) = Archive::Zip::tempFile();
- my ($fh, $name) = Archive::Zip::tempFile('myTempDir');
- my $fh = Archive::Zip::tempFile(); # if you don't need the name
-
-=back
-
-=head2 Zip Archive Accessors
-
-=over 4
-
-=item members()
-
-Return a copy of the members array
-
- my @members = $zip->members();
-
-=item numberOfMembers()
-
-Return the number of members I have
-
-=item memberNames()
-
-Return a list of the (internal) file names of the zip members
-
-=item memberNamed( $string )
-
-Return ref to member whose filename equals given filename or
-undef. C<$string> must be in Zip (Unix) filename format.
-
-=item membersMatching( $regex )
-
-Return array of members whose filenames match given regular
-expression in list context. Returns number of matching
-members in scalar context.
-
- my @textFileMembers = $zip->membersMatching( '.*\.txt' );
- # or
- my $numberOfTextFiles = $zip->membersMatching( '.*\.txt' );
-
-=item diskNumber()
-
-Return the disk that I start on. Not used for writing zips,
-but might be interesting if you read a zip in. This should be
-0, as Archive::Zip does not handle multi-volume archives.
-
-=item diskNumberWithStartOfCentralDirectory()
-
-Return the disk number that holds the beginning of the
-central directory. Not used for writing zips, but might be
-interesting if you read a zip in. This should be 0, as
-Archive::Zip does not handle multi-volume archives.
-
-=item numberOfCentralDirectoriesOnThisDisk()
-
-Return the number of CD structures in the zipfile last read in.
-Not used for writing zips, but might be interesting if you read a zip
-in.
-
-=item numberOfCentralDirectories()
-
-Return the number of CD structures in the zipfile last read in.
-Not used for writing zips, but might be interesting if you read a zip
-in.
-
-=item centralDirectorySize()
-
-Returns central directory size, as read from an external zip
-file. Not used for writing zips, but might be interesting if
-you read a zip in.
-
-=item centralDirectoryOffsetWRTStartingDiskNumber()
-
-Returns the offset into the zip file where the CD begins. Not
-used for writing zips, but might be interesting if you read a
-zip in.
-
-=item zipfileComment( [$string] )
-
-Get or set the zipfile comment. Returns the old comment.
-
- print $zip->zipfileComment();
- $zip->zipfileComment( 'New Comment' );
-
-=item eocdOffset()
-
-Returns the (unexpected) number of bytes between where the
-EOCD was found and where it expected to be. This is normally
-0, but would be positive if something (a virus, perhaps) had
-added bytes somewhere before the EOCD. Not used for writing
-zips, but might be interesting if you read a zip in. Here is
-an example of how you can diagnose this:
-
- my $zip = Archive::Zip->new('somefile.zip');
- if ($zip->eocdOffset())
- {
- warn "A virus has added ", $zip->eocdOffset, " bytes of garbage\n";
- }
-
-The C<eocdOffset()> is used to adjust the starting position of member
-headers, if necessary.
-
-=item fileName()
-
-Returns the name of the file last read from. If nothing has
-been read yet, returns an empty string; if read from a file
-handle, returns the handle in string form.
-
-=back
-
-=head2 Zip Archive Member Operations
-
-Various operations on a zip file modify members. When a member is
-passed as an argument, you can either use a reference to the member
-itself, or the name of a member. Of course, using the name requires
-that names be unique within a zip (this is not enforced).
-
-=over 4
-
-=item removeMember( $memberOrName )
-
-Remove and return the given member, or match its name and
-remove it. Returns undef if member or name doesn't exist in this
-Zip. No-op if member does not belong to this zip.
-
-=item replaceMember( $memberOrName, $newMember )
-
-Remove and return the given member, or match its name and
-remove it. Replace with new member. Returns undef if member or
-name doesn't exist in this Zip, or if C<$newMember> is undefined.
-
-It is an (undiagnosed) error to provide a C<$newMember> that is a
-member of the zip being modified.
-
- my $member1 = $zip->removeMember( 'xyz' );
- my $member2 = $zip->replaceMember( 'abc', $member1 );
- # now, $member2 (named 'abc') is not in $zip,
- # and $member1 (named 'xyz') is, having taken $member2's place.
-
-=item extractMember( $memberOrName [, $extractedName ] )
-
-Extract the given member, or match its name and extract it.
-Returns undef if member doesn't exist in this Zip. If
-optional second arg is given, use it as the name of the
-extracted member. Otherwise, the internal filename of the
-member is used as the name of the extracted file or
-directory.
-If you pass C<$extractedName>, it should be in the local file
-system's format.
-All necessary directories will be created. Returns C<AZ_OK>
-on success.
-
-=item extractMemberWithoutPaths( $memberOrName [, $extractedName ] )
-
-Extract the given member, or match its name and extract it.
-Does not use path information (extracts into the current
-directory). Returns undef if member doesn't exist in this
-Zip.
-If optional second arg is given, use it as the name of the
-extracted member (its paths will be deleted too). Otherwise,
-the internal filename of the member (minus paths) is used as
-the name of the extracted file or directory. Returns C<AZ_OK>
-on success.
-
-=item addMember( $member )
-
-Append a member (possibly from another zip file) to the zip
-file. Returns the new member. Generally, you will use
-addFile(), addDirectory(), addFileOrDirectory(), addString(),
-or read() to add members.
-
- # Move member named 'abc' to end of zip:
- my $member = $zip->removeMember( 'abc' );
- $zip->addMember( $member );
-
-=item updateMember( $memberOrName, $fileName )
-
-Update a single member from the file or directory named C<$fileName>.
-Returns the (possibly added or updated) member, if any; C<undef> on
-errors.
-The comparison is based on C<lastModTime()> and (in the case of a
-non-directory) the size of the file.
-
-=item addFile( $fileName [, $newName ] )
-
-Append a member whose data comes from an external file,
-returning the member or undef. The member will have its file
-name set to the name of the external file, and its
-desiredCompressionMethod set to COMPRESSION_DEFLATED. The
-file attributes and last modification time will be set from
-the file.
-If the name given does not represent a readable plain file or
-symbolic link, undef will be returned. C<$fileName> must be
-in the format required for the local file system.
-The optional C<$newName> argument sets the internal file name
-to something different than the given $fileName. C<$newName>,
-if given, must be in Zip name format (i.e. Unix).
-The text mode bit will be set if the contents appears to be
-text (as returned by the C<-T> perl operator).
-
-
-I<NOTE> that you shouldn't (generally) use absolute path names
-in zip member names, as this will cause problems with some zip
-tools as well as introduce a security hole and make the zip
-harder to use.
-
-=item addDirectory( $directoryName [, $fileName ] )
-
-
-
-Append a member created from the given directory name. The
-directory name does not have to name an existing directory.
-If the named directory exists, the file modification time and
-permissions are set from the existing directory, otherwise
-they are set to now and permissive default permissions.
-C<$directoryName> must be in local file system format.
-The optional second argument sets the name of the archive
-member (which defaults to C<$directoryName>). If given, it
-must be in Zip (Unix) format.
-Returns the new member.
-
-=item addFileOrDirectory( $name [, $newName ] )
-
-
-
-Append a member from the file or directory named $name. If
-$newName is given, use it for the name of the new member.
-Will add or remove trailing slashes from $newName as needed.
-C<$name> must be in local file system format.
-The optional second argument sets the name of the archive
-member (which defaults to C<$name>). If given, it must be in
-Zip (Unix) format.
-
-=item addString( $stringOrStringRef, $name )
-
-
-
-Append a member created from the given string or string
-reference. The name is given by the second argument.
-Returns the new member. The last modification time will be
-set to now, and the file attributes will be set to permissive
-defaults.
-
- my $member = $zip->addString( 'This is a test', 'test.txt' );
-
-=item contents( $memberOrMemberName [, $newContents ] )
-
-
-
-Returns the uncompressed data for a particular member, or
-undef.
-
- print "xyz.txt contains " . $zip->contents( 'xyz.txt' );
-
-Also can change the contents of a member:
-
- $zip->contents( 'xyz.txt', 'This is the new contents' );
-
-If called expecting an array as the return value, it will include
-the status as the second value in the array.
-
- ($content, $status) = $zip->contents( 'xyz.txt');
-
-=back
-
-=head2 Zip Archive I/O operations
-
-
-A Zip archive can be written to a file or file handle, or read from
-one.
-
-=over 4
-
-=item writeToFileNamed( $fileName )
-
-
-
-Write a zip archive to named file. Returns C<AZ_OK> on
-success.
-
- my $status = $zip->writeToFileNamed( 'xx.zip' );
- die "error somewhere" if $status != AZ_OK;
-
-Note that if you use the same name as an existing zip file
-that you read in, you will clobber ZipFileMembers. So
-instead, write to a different file name, then delete the
-original.
-If you use the C<overwrite()> or C<overwriteAs()> methods, you can
-re-write the original zip in this way.
-C<$fileName> should be a valid file name on your system.
-
-=item writeToFileHandle( $fileHandle [, $seekable] )
-
-Write a zip archive to a file handle. Return AZ_OK on
-success. The optional second arg tells whether or not to try
-to seek backwards to re-write headers. If not provided, it is
-set if the Perl C<-f> test returns true. This could fail on
-some operating systems, though.
-
- my $fh = IO::File->new( 'someFile.zip', 'w' );
- unless ( $zip->writeToFileHandle( $fh ) != AZ_OK ) {
- # error handling
- }
-
-If you pass a file handle that is not seekable (like if
-you're writing to a pipe or a socket), pass a false second
-argument:
-
- my $fh = IO::File->new( '| cat > somefile.zip', 'w' );
- $zip->writeToFileHandle( $fh, 0 ); # fh is not seekable
-
-If this method fails during the write of a member, that
-member and all following it will return false from
-C<wasWritten()>. See writeCentralDirectory() for a way to
-deal with this.
-If you want, you can write data to the file handle before
-passing it to writeToFileHandle(); this could be used (for
-instance) for making self-extracting archives. However, this
-only works reliably when writing to a real file (as opposed
-to STDOUT or some other possible non-file).
-
-See examples/selfex.pl for how to write a self-extracting
-archive.
-
-=item writeCentralDirectory( $fileHandle [, $offset ] )
-
-Writes the central directory structure to the given file
-handle.
-
-Returns AZ_OK on success. If given an $offset, will
-seek to that point before writing. This can be used for
-recovery in cases where writeToFileHandle or writeToFileNamed
-returns an IO error because of running out of space on the
-destination file.
-
-You can truncate the zip by seeking backwards and then writing the
-directory:
-
- my $fh = IO::File->new( 'someFile.zip', 'w' );
- my $retval = $zip->writeToFileHandle( $fh );
- if ( $retval == AZ_IO_ERROR ) {
- my @unwritten = grep { not $_->wasWritten() } $zip->members();
- if (@unwritten) {
- $zip->removeMember( $member ) foreach my $member ( @unwritten );
- $zip->writeCentralDirectory( $fh,
- $unwritten[0]->writeLocalHeaderRelativeOffset());
- }
- }
-
-=item overwriteAs( $newName )
-
-Write the zip to the specified file, as safely as possible.
-This is done by first writing to a temp file, then renaming
-the original if it exists, then renaming the temp file, then
-deleting the renamed original if it exists. Returns AZ_OK if
-successful.
-
-=item overwrite()
-
-Write back to the original zip file. See overwriteAs() above.
-If the zip was not ever read from a file, this generates an
-error.
-
-=item read( $fileName )
-
-Read zipfile headers from a zip file, appending new members.
-Returns C<AZ_OK> or error code.
-
- my $zipFile = Archive::Zip->new();
- my $status = $zipFile->read( '/some/FileName.zip' );
-
-=item readFromFileHandle( $fileHandle, $filename )
-
-Read zipfile headers from an already-opened file handle,
-appending new members. Does not close the file handle.
-Returns C<AZ_OK> or error code. Note that this requires a
-seekable file handle; reading from a stream is not yet
-supported.
-
- my $fh = IO::File->new( '/some/FileName.zip', 'r' );
- my $zip1 = Archive::Zip->new();
- my $status = $zip1->readFromFileHandle( $fh );
- my $zip2 = Archive::Zip->new();
- $status = $zip2->readFromFileHandle( $fh );
-
-=back
-
-=head2 Zip Archive Tree operations
-
-These used to be in Archive::Zip::Tree but got moved into
-Archive::Zip. They enable operation on an entire tree of members or
-files.
-A usage example:
-
- use Archive::Zip;
- my $zip = Archive::Zip->new();
-
- # add all readable files and directories below . as xyz/*
- $zip->addTree( '.', 'xyz' );
-
- # add all readable plain files below /abc as def/*
- $zip->addTree( '/abc', 'def', sub { -f && -r } );
-
- # add all .c files below /tmp as stuff/*
- $zip->addTreeMatching( '/tmp', 'stuff', '\.c$' );
-
- # add all .o files below /tmp as stuff/* if they aren't writable
- $zip->addTreeMatching( '/tmp', 'stuff', '\.o$', sub { ! -w } );
-
- # add all .so files below /tmp that are smaller than 200 bytes as stuff/*
- $zip->addTreeMatching( '/tmp', 'stuff', '\.o$', sub { -s < 200 } );
-
- # and write them into a file
- $zip->writeToFileNamed('xxx.zip');
-
- # now extract the same files into /tmpx
- $zip->extractTree( 'stuff', '/tmpx' );
-
-=over 4
-
-=item $zip->addTree( $root, $dest [,$pred] ) -- Add tree of files to a zip
-
-C<$root> is the root of the tree of files and directories to be
-added. It is a valid directory name on your system. C<$dest> is
-the name for the root in the zip file (undef or blank means
-to use relative pathnames). It is a valid ZIP directory name
-(that is, it uses forward slashes (/) for separating
-directory components). C<$pred> is an optional subroutine
-reference to select files: it is passed the name of the
-prospective file or directory using C<$_>, and if it returns
-true, the file or directory will be included. The default is
-to add all readable files and directories. For instance,
-using
-
- my $pred = sub { /\.txt/ };
- $zip->addTree( '.', '', $pred );
-
-will add all the .txt files in and below the current
-directory, using relative names, and making the names
-identical in the zipfile:
-
- original name zip member name
- ./xyz xyz
- ./a/ a/
- ./a/b a/b
-
-To translate absolute to relative pathnames, just pass them
-in: $zip->addTree( '/c/d', 'a' );
-
- original name zip member name
- /c/d/xyz a/xyz
- /c/d/a/ a/a/
- /c/d/a/b a/a/b
-
-Returns AZ_OK on success. Note that this will not follow
-symbolic links to directories. Note also that this does not
-check for the validity of filenames.
-
-Note that you generally I<don't> want to make zip archive member names
-absolute.
-
-=item $zip->addTreeMatching( $root, $dest, $pattern [,$pred] )
-
-$root is the root of the tree of files and directories to be
-added $dest is the name for the root in the zip file (undef
-means to use relative pathnames) $pattern is a (non-anchored)
-regular expression for filenames to match $pred is an
-optional subroutine reference to select files: it is passed
-the name of the prospective file or directory in C<$_>, and
-if it returns true, the file or directory will be included.
-The default is to add all readable files and directories. To
-add all files in and below the current dirctory whose names
-end in C<.pl>, and make them extract into a subdirectory
-named C<xyz>, do this:
-
- $zip->addTreeMatching( '.', 'xyz', '\.pl$' )
-
-To add all I<writable> files in and below the dirctory named
-C</abc> whose names end in C<.pl>, and make them extract into
-a subdirectory named C<xyz>, do this:
-
- $zip->addTreeMatching( '/abc', 'xyz', '\.pl$', sub { -w } )
-
-Returns AZ_OK on success. Note that this will not follow
-symbolic links to directories.
-
-=item $zip->updateTree( $root, [ $dest, [ $pred [, $mirror]]] );
-
-
-
-Update a zip file from a directory tree.
-
-C<updateTree()> takes the same arguments as C<addTree()>, but first
-checks to see whether the file or directory already exists in the zip
-file, and whether it has been changed.
-
-If the fourth argument C<$mirror> is true, then delete all my members
-if corresponding files weren't found.
-
-
-Returns an error code or AZ_OK if all is well.
-
-=item $zip->extractTree()
-
-
-
-=item $zip->extractTree( $root )
-
-
-
-=item $zip->extractTree( $root, $dest )
-
-
-
-=item $zip->extractTree( $root, $dest, $volume )
-
-
-
-If you don't give any arguments at all, will extract all the
-files in the zip with their original names.
-
-
-If you supply one argument for C<$root>, C<extractTree> will extract
-all the members whose names start with C<$root> into the current
-directory, stripping off C<$root> first.
-C<$root> is in Zip (Unix) format.
-For instance,
-
- $zip->extractTree( 'a' );
-
-when applied to a zip containing the files:
-a/x a/b/c ax/d/e d/e will extract:
-
-
-a/x as ./x
-
-
-a/b/c as ./b/c
-
-
-If you give two arguments, C<extractTree> extracts all the members
-whose names start with C<$root>. It will translate C<$root> into
-C<$dest> to construct the destination file name.
-C<$root> and C<$dest> are in Zip (Unix) format.
-For instance,
-
- $zip->extractTree( 'a', 'd/e' );
-
-when applied to a zip containing the files:
-a/x a/b/c ax/d/e d/e will extract:
-
-
-a/x to d/e/x
-
-
-a/b/c to d/e/b/c and ignore ax/d/e and d/e
-
-
-If you give three arguments, C<extractTree> extracts all the members
-whose names start with C<$root>. It will translate C<$root> into
-C<$dest> to construct the destination file name, and then it will
-convert to local file system format, using C<$volume> as the name of
-the destination volume.
-
-
-C<$root> and C<$dest> are in Zip (Unix) format.
-
-
-C<$volume> is in local file system format.
-
-
-For instance, under Windows,
-
- $zip->extractTree( 'a', 'd/e', 'f:' );
-
-when applied to a zip containing the files:
-a/x a/b/c ax/d/e d/e will extract:
-
-
-a/x to f:d/e/x
-
-
-a/b/c to f:d/e/b/c and ignore ax/d/e and d/e
-
-
-If you want absolute paths (the prior example used paths relative to
-the current directory on the destination volume, you can specify these
-in C<$dest>:
-
- $zip->extractTree( 'a', '/d/e', 'f:' );
-
-when applied to a zip containing the files:
-a/x a/b/c ax/d/e d/e will extract:
-
-
-a/x to f:\d\e\x
-
-
-a/b/c to f:\d\e\b\c and ignore ax/d/e and d/e
-
-Returns an error code or AZ_OK if everything worked OK.
-
-=back
-
-=head1 MEMBER OPERATIONS
-
-
-=head2 Member Class Methods
-
-
-Several constructors allow you to construct members without adding
-them to a zip archive. These work the same as the addFile(),
-addDirectory(), and addString() zip instance methods described above,
-but they don't add the new members to a zip.
-
-=over 4
-
-=item Archive::Zip::Member->newFromString( $stringOrStringRef [, $fileName] )
-
-
-
-Construct a new member from the given string. Returns undef
-on error.
-
- my $member = Archive::Zip::Member->newFromString( 'This is a test',
- 'xyz.txt' );
-
-=item newFromFile( $fileName )
-
-
-
-Construct a new member from the given file. Returns undef on
-error.
-
- my $member = Archive::Zip::Member->newFromFile( 'xyz.txt' );
-
-=item newDirectoryNamed( $directoryName [, $zipname ] )
-
-
-
-Construct a new member from the given directory.
-C<$directoryName> must be a valid name on your file system; it doesn't
-have to exist.
-
-
-If given, C<$zipname> will be the name of the zip member; it must be a
-valid Zip (Unix) name. If not given, it will be converted from
-C<$directoryName>.
-
-
-Returns undef on error.
-
- my $member = Archive::Zip::Member->newDirectoryNamed( 'CVS/' );
-
-=back
-
-=head2 Member Simple accessors
-
-
-These methods get (and/or set) member attribute values.
-
-=over 4
-
-=item versionMadeBy()
-
-
-
-Gets the field from the member header.
-
-=item fileAttributeFormat( [$format] )
-
-
-
-Gets or sets the field from the member header. These are
-C<FA_*> values.
-
-=item versionNeededToExtract()
-
-
-
-Gets the field from the member header.
-
-=item bitFlag()
-
-
-
-Gets the general purpose bit field from the member header.
-This is where the C<GPBF_*> bits live.
-
-=item compressionMethod()
-
-
-
-Returns the member compression method. This is the method
-that is currently being used to compress the member data.
-This will be COMPRESSION_STORED for added string or file
-members, or any of the C<COMPRESSION_*> values for members
-from a zip file. However, this module can only handle members
-whose data is in COMPRESSION_STORED or COMPRESSION_DEFLATED
-format.
-
-=item desiredCompressionMethod( [$method] )
-
-
-
-Get or set the member's C<desiredCompressionMethod>. This is
-the compression method that will be used when the member is
-written. Returns prior desiredCompressionMethod. Only
-COMPRESSION_DEFLATED or COMPRESSION_STORED are valid
-arguments. Changing to COMPRESSION_STORED will change the
-member desiredCompressionLevel to 0; changing to
-COMPRESSION_DEFLATED will change the member
-desiredCompressionLevel to COMPRESSION_LEVEL_DEFAULT.
-
-=item desiredCompressionLevel( [$method] )
-
-
-
-Get or set the member's desiredCompressionLevel This is the
-method that will be used to write. Returns prior
-desiredCompressionLevel. Valid arguments are 0 through 9,
-COMPRESSION_LEVEL_NONE, COMPRESSION_LEVEL_DEFAULT,
-COMPRESSION_LEVEL_BEST_COMPRESSION, and
-COMPRESSION_LEVEL_FASTEST. 0 or COMPRESSION_LEVEL_NONE will
-change the desiredCompressionMethod to COMPRESSION_STORED.
-All other arguments will change the desiredCompressionMethod
-to COMPRESSION_DEFLATED.
-
-=item externalFileName()
-
-
-
-Return the member's external file name, if any, or undef.
-
-=item fileName()
-
-
-
-Get or set the member's internal filename. Returns the
-(possibly new) filename. Names will have backslashes
-converted to forward slashes, and will have multiple
-consecutive slashes converted to single ones.
-
-=item lastModFileDateTime()
-
-
-
-Return the member's last modification date/time stamp in
-MS-DOS format.
-
-=item lastModTime()
-
-
-
-Return the member's last modification date/time stamp,
-converted to unix localtime format.
-
- print "Mod Time: " . scalar( localtime( $member->lastModTime() ) );
-
-=item setLastModFileDateTimeFromUnix()
-
-Set the member's lastModFileDateTime from the given unix
-time.
-
- $member->setLastModFileDateTimeFromUnix( time() );
-
-=item internalFileAttributes()
-
-Return the internal file attributes field from the zip
-header. This is only set for members read from a zip file.
-
-=item externalFileAttributes()
-
-Return member attributes as read from the ZIP file. Note that
-these are NOT UNIX!
-
-=item unixFileAttributes( [$newAttributes] )
-
-Get or set the member's file attributes using UNIX file
-attributes. Returns old attributes.
-
- my $oldAttribs = $member->unixFileAttributes( 0666 );
-
-Note that the return value has more than just the file
-permissions, so you will have to mask off the lowest bits for
-comparisions.
-
-=item localExtraField( [$newField] )
-
-Gets or sets the extra field that was read from the local
-header. This is not set for a member from a zip file until
-after the member has been written out. The extra field must
-be in the proper format.
-
-=item cdExtraField( [$newField] )
-
-Gets or sets the extra field that was read from the central
-directory header. The extra field must be in the proper
-format.
-
-=item extraFields()
-
-Return both local and CD extra fields, concatenated.
-
-=item fileComment( [$newComment] )
-
-Get or set the member's file comment.
-
-=item hasDataDescriptor()
-
-Get or set the data descriptor flag. If this is set, the
-local header will not necessarily have the correct data
-sizes. Instead, a small structure will be stored at the end
-of the member data with these values. This should be
-transparent in normal operation.
-
-=item crc32()
-
-Return the CRC-32 value for this member. This will not be set
-for members that were constructed from strings or external
-files until after the member has been written.
-
-=item crc32String()
-
-Return the CRC-32 value for this member as an 8 character
-printable hex string. This will not be set for members that
-were constructed from strings or external files until after
-the member has been written.
-
-=item compressedSize()
-
-Return the compressed size for this member. This will not be
-set for members that were constructed from strings or
-external files until after the member has been written.
-
-=item uncompressedSize()
-
-Return the uncompressed size for this member.
-
-=item isEncrypted()
-
-Return true if this member is encrypted. The Archive::Zip
-module does not currently create or extract encrypted
-members.
-
-=item isTextFile( [$flag] )
-
-Returns true if I am a text file. Also can set the status if
-given an argument (then returns old state). Note that this
-module does not currently do anything with this flag upon
-extraction or storage. That is, bytes are stored in native
-format whether or not they came from a text file.
-
-=item isBinaryFile()
-
-Returns true if I am a binary file. Also can set the status
-if given an argument (then returns old state). Note that this
-module does not currently do anything with this flag upon
-extraction or storage. That is, bytes are stored in native
-format whether or not they came from a text file.
-
-=item extractToFileNamed( $fileName )
-
-Extract me to a file with the given name. The file will be
-created with default modes. Directories will be created as
-needed.
-The C<$fileName> argument should be a valid file name on your
-file system.
-Returns AZ_OK on success.
-
-=item isDirectory()
-
-Returns true if I am a directory.
-
-=item writeLocalHeaderRelativeOffset()
-
-Returns the file offset in bytes the last time I was written.
-
-=item wasWritten()
-
-Returns true if I was successfully written. Reset at the
-beginning of a write attempt.
-
-=back
-
-=head2 Low-level member data reading
-
-It is possible to use lower-level routines to access member data
-streams, rather than the extract* methods and contents(). For
-instance, here is how to print the uncompressed contents of a member
-in chunks using these methods:
-
- my ( $member, $status, $bufferRef );
- $member = $zip->memberNamed( 'xyz.txt' );
- $member->desiredCompressionMethod( COMPRESSION_STORED );
- $status = $member->rewindData();
- die "error $status" unless $status == AZ_OK;
- while ( ! $member->readIsDone() )
- {
- ( $bufferRef, $status ) = $member->readChunk();
- die "error $status"
- if $status != AZ_OK && $status != AZ_STREAM_END;
- # do something with $bufferRef:
- print $$bufferRef;
- }
- $member->endRead();
-
-=over 4
-
-=item readChunk( [$chunkSize] )
-
-This reads the next chunk of given size from the member's
-data stream and compresses or uncompresses it as necessary,
-returning a reference to the bytes read and a status. If size
-argument is not given, defaults to global set by
-Archive::Zip::setChunkSize. Status is AZ_OK on success until
-the last chunk, where it returns AZ_STREAM_END. Returns C<(
-\$bytes, $status)>.
-
- my ( $outRef, $status ) = $self->readChunk();
- print $$outRef if $status != AZ_OK && $status != AZ_STREAM_END;
-
-=item rewindData()
-
-Rewind data and set up for reading data streams or writing
-zip files. Can take options for C<inflateInit()> or
-C<deflateInit()>, but this isn't likely to be necessary.
-Subclass overrides should call this method. Returns C<AZ_OK>
-on success.
-
-=item endRead()
-
-Reset the read variables and free the inflater or deflater.
-Must be called to close files, etc. Returns AZ_OK on success.
-
-=item readIsDone()
-
-Return true if the read has run out of data or errored out.
-
-=item contents()
-
-Return the entire uncompressed member data or undef in scalar
-context. When called in array context, returns C<( $string,
-$status )>; status will be AZ_OK on success:
-
- my $string = $member->contents();
- # or
- my ( $string, $status ) = $member->contents();
- die "error $status" unless $status == AZ_OK;
-
-Can also be used to set the contents of a member (this may
-change the class of the member):
-
- $member->contents( "this is my new contents" );
-
-=item extractToFileHandle( $fh )
-
-Extract (and uncompress, if necessary) the member's contents
-to the given file handle. Return AZ_OK on success.
-
-=back
-
-=head1 Archive::Zip::FileMember methods
-
-The Archive::Zip::FileMember class extends Archive::Zip::Member. It is the
-base class for both ZipFileMember and NewFileMember classes. This class adds
-an C<externalFileName> and an C<fh> member to keep track of the external
-file.
-
-=over 4
-
-=item externalFileName()
-
-Return the member's external filename.
-
-=item fh()
-
-Return the member's read file handle. Automatically opens file if
-necessary.
-
-=back
-
-=head1 Archive::Zip::ZipFileMember methods
-
-The Archive::Zip::ZipFileMember class represents members that have been read
-from external zip files.
-
-=over 4
-
-=item diskNumberStart()
-
-Returns the disk number that the member's local header resides in.
-Should be 0.
-
-=item localHeaderRelativeOffset()
-
-Returns the offset into the zip file where the member's local header
-is.
-
-=item dataOffset()
-
-Returns the offset from the beginning of the zip file to the member's
-data.
-
-=back
-
-=head1 REQUIRED MODULES
-
-L<Archive::Zip> requires several other modules:
-
-L<Carp>
-
-L<Compress::Zlib>
-
-L<Cwd>
-
-L<File::Basename>
-
-L<File::Copy>
-
-L<File::Find>
-
-L<File::Path>
-
-L<File::Spec>
-
-L<File::Spec>
-
-L<IO::File>
-
-L<IO::Seekable>
-
-L<Time::Local>
-
-=head1 BUGS AND CAVEATS
-
-=head2 When not to use Archive::Zip
-
-If you are just going to be extracting zips (and/or other archives) you
-are recommended to look at using L<Archive::Extract> instead, as it is much
-easier to use and factors out archive-specific functionality.
-
-=head2 Try to avoid IO::Scalar
-
-One of the most common ways to use Archive::Zip is to generate Zip files
-in-memory. Most people have use L<IO::Scalar> for this purpose.
-
-Unfortunately, as of 1.11 this module no longer works with L<IO::Scalar>
-as it incorrectly implements seeking.
-
-Anybody using L<IO::Scalar> should consider porting to L<IO::String>,
-which is smaller, lighter, and is implemented to be perfectly compatible
-with regular seekable filehandles.
-
-Support for L<IO::Scalar> most likely will B<not> be restored in the
-future, as L<IO::Scalar> itself cannot change the way it is implemented
-due to back-compatibility issues.
-
-=head1 TO DO
-
-* auto-choosing storing vs compression
-
-* extra field hooks (see notes.txt)
-
-* check for dups on addition/renaming?
-
-* Text file extraction (line end translation)
-
-* Reading zip files from non-seekable inputs
- (Perhaps by proxying through IO::String?)
-
-* separate unused constants into separate module
-
-* cookbook style docs
-
-* Handle tainted paths correctly
-
-* Work on better compatability with other IO:: modules
-
-=head1 SUPPORT
-
-Bugs should be reported via the CPAN bug tracker
-
-L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Archive-Zip>
-
-For other issues contact the maintainer
-
-=head1 AUTHOR
-
-Adam Kennedy E<lt>adamk@cpan.orgE<gt>
-
-Previously maintained by Steve Peters E<lt>steve@fisharerojo.orgE<gt>.
-
-File attributes code by Maurice Aubrey E<lt>maurice@lovelyfilth.comE<gt>.
-
-Originally by Ned Konz E<lt>nedkonz@cpan.orgE<gt>.
-
-=head1 COPYRIGHT
-
-Copyright 2000 - 2004 Ned Konz.
-
-Some parts copyright 2005 Steve Peters.
-
-Some parts copyright 2006 - 2007 Adam Kennedy.
-
-This program is free software; you can redistribute it and/or modify
-it under the same terms as Perl itself.
-
-=head1 SEE ALSO
-
-L<Compress::Zlib>, L<Archive::Tar>, L<Archive::Extract>
-
-There is a Japanese translation of this
-document at L<http://www.memb.jp/~deq/perl/doc-ja/Archive-Zip.html>
-that was done by DEQ E<lt>deq@oct.zaq.ne.jpE<gt> . Thanks!
-
-=cut
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Archive/Zip/Archive.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Archive/Zip/Archive.pm
deleted file mode 100644
index 5b837b063a4..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Archive/Zip/Archive.pm
+++ /dev/null
@@ -1,786 +0,0 @@
-package Archive::Zip::Archive;
-
-# Represents a generic ZIP archive
-
-use strict;
-use File::Path;
-use File::Find ();
-use File::Spec ();
-use File::Copy ();
-use File::Basename;
-use Cwd;
-
-use vars qw( $VERSION @ISA );
-
-BEGIN {
- $VERSION = '1.23';
- @ISA = qw( Archive::Zip );
-}
-
-use Archive::Zip qw(
- :CONSTANTS
- :ERROR_CODES
- :PKZIP_CONSTANTS
- :UTILITY_METHODS
-);
-
-# Note that this returns undef on read errors, else new zip object.
-
-sub new {
- my $class = shift;
- my $self = bless(
- {
- 'diskNumber' => 0,
- 'diskNumberWithStartOfCentralDirectory' => 0,
- 'numberOfCentralDirectoriesOnThisDisk' => 0, # shld be # of members
- 'numberOfCentralDirectories' => 0, # shld be # of members
- 'centralDirectorySize' => 0, # must re-compute on write
- 'centralDirectoryOffsetWRTStartingDiskNumber' =>
- 0, # must re-compute
- 'writeEOCDOffset' => 0,
- 'writeCentralDirectoryOffset' => 0,
- 'zipfileComment' => '',
- 'eocdOffset' => 0,
- 'fileName' => ''
- },
- $class
- );
- $self->{'members'} = [];
- if (@_) {
- my $status = $self->read(@_);
- return $status == AZ_OK ? $self : undef;
- }
- return $self;
-}
-
-sub members {
- @{ shift->{'members'} };
-}
-
-sub numberOfMembers {
- scalar( shift->members() );
-}
-
-sub memberNames {
- my $self = shift;
- return map { $_->fileName() } $self->members();
-}
-
-# return ref to member with given name or undef
-sub memberNamed {
- my ( $self, $fileName ) = @_;
- foreach my $member ( $self->members() ) {
- return $member if $member->fileName() eq $fileName;
- }
- return undef;
-}
-
-sub membersMatching {
- my ( $self, $pattern ) = @_;
- return grep { $_->fileName() =~ /$pattern/ } $self->members();
-}
-
-sub diskNumber {
- shift->{'diskNumber'};
-}
-
-sub diskNumberWithStartOfCentralDirectory {
- shift->{'diskNumberWithStartOfCentralDirectory'};
-}
-
-sub numberOfCentralDirectoriesOnThisDisk {
- shift->{'numberOfCentralDirectoriesOnThisDisk'};
-}
-
-sub numberOfCentralDirectories {
- shift->{'numberOfCentralDirectories'};
-}
-
-sub centralDirectorySize {
- shift->{'centralDirectorySize'};
-}
-
-sub centralDirectoryOffsetWRTStartingDiskNumber {
- shift->{'centralDirectoryOffsetWRTStartingDiskNumber'};
-}
-
-sub zipfileComment {
- my $self = shift;
- my $comment = $self->{'zipfileComment'};
- if (@_) {
- $self->{'zipfileComment'} = pack( 'C0a*', shift() ); # avoid unicode
- }
- return $comment;
-}
-
-sub eocdOffset {
- shift->{'eocdOffset'};
-}
-
-# Return the name of the file last read.
-sub fileName {
- shift->{'fileName'};
-}
-
-sub removeMember {
- my ( $self, $member ) = @_;
- $member = $self->memberNamed($member) unless ref($member);
- return undef unless $member;
- my @newMembers = grep { $_ != $member } $self->members();
- $self->{'members'} = \@newMembers;
- return $member;
-}
-
-sub replaceMember {
- my ( $self, $oldMember, $newMember ) = @_;
- $oldMember = $self->memberNamed($oldMember) unless ref($oldMember);
- return undef unless $oldMember;
- return undef unless $newMember;
- my @newMembers =
- map { ( $_ == $oldMember ) ? $newMember : $_ } $self->members();
- $self->{'members'} = \@newMembers;
- return $oldMember;
-}
-
-sub extractMember {
- my $self = shift;
- my $member = shift;
- $member = $self->memberNamed($member) unless ref($member);
- return _error('member not found') unless $member;
- my $originalSize = $member->compressedSize();
- my $name = shift; # local FS name if given
- my ( $volumeName, $dirName, $fileName );
- if ( defined($name) ) {
- ( $volumeName, $dirName, $fileName ) = File::Spec->splitpath($name);
- $dirName = File::Spec->catpath( $volumeName, $dirName, '' );
- }
- else {
- $name = $member->fileName();
- ( $dirName = $name ) =~ s{[^/]*$}{};
- $dirName = Archive::Zip::_asLocalName($dirName);
- $name = Archive::Zip::_asLocalName($name);
- }
- if ( $dirName && !-d $dirName ) {
- mkpath($dirName);
- return _ioError("can't create dir $dirName") if ( !-d $dirName );
- }
- my $rc = $member->extractToFileNamed( $name, @_ );
-
- # TODO refactor this fix into extractToFileNamed()
- $member->{'compressedSize'} = $originalSize;
- return $rc;
-}
-
-sub extractMemberWithoutPaths {
- my $self = shift;
- my $member = shift;
- $member = $self->memberNamed($member) unless ref($member);
- return _error('member not found') unless $member;
- my $originalSize = $member->compressedSize();
- return AZ_OK if $member->isDirectory();
- my $name = shift;
- unless ($name) {
- $name = $member->fileName();
- $name =~ s{.*/}{}; # strip off directories, if any
- $name = Archive::Zip::_asLocalName($name);
- }
- my $rc = $member->extractToFileNamed( $name, @_ );
- $member->{'compressedSize'} = $originalSize;
- return $rc;
-}
-
-sub addMember {
- my ( $self, $newMember ) = @_;
- push( @{ $self->{'members'} }, $newMember ) if $newMember;
- return $newMember;
-}
-
-sub addFile {
- my $self = shift;
- my $fileName = shift;
- my $newName = shift;
- my $newMember = $self->ZIPMEMBERCLASS->newFromFile( $fileName, $newName );
- $self->addMember($newMember) if defined($newMember);
- return $newMember;
-}
-
-sub addString {
- my $self = shift;
- my $newMember = $self->ZIPMEMBERCLASS->newFromString(@_);
- return $self->addMember($newMember);
-}
-
-sub addDirectory {
- my ( $self, $name, $newName ) = @_;
- my $newMember = $self->ZIPMEMBERCLASS->newDirectoryNamed( $name, $newName );
- $self->addMember($newMember);
- return $newMember;
-}
-
-# add either a file or a directory.
-
-sub addFileOrDirectory {
- my ( $self, $name, $newName ) = @_;
- if ( -f $name ) {
- ( $newName =~ s{/$}{} ) if $newName;
- return $self->addFile( $name, $newName );
- }
- elsif ( -d $name ) {
- ( $newName =~ s{[^/]$}{&/} ) if $newName;
- return $self->addDirectory( $name, $newName );
- }
- else {
- return _error("$name is neither a file nor a directory");
- }
-}
-
-sub contents {
- my ( $self, $member, $newContents ) = @_;
- return _error('No member name given') unless $member;
- $member = $self->memberNamed($member) unless ref($member);
- return undef unless $member;
- return $member->contents($newContents);
-}
-
-sub writeToFileNamed {
- my $self = shift;
- my $fileName = shift; # local FS format
- foreach my $member ( $self->members() ) {
- if ( $member->_usesFileNamed($fileName) ) {
- return _error( "$fileName is needed by member "
- . $member->fileName()
- . "; consider using overwrite() or overwriteAs() instead." );
- }
- }
- my ( $status, $fh ) = _newFileHandle( $fileName, 'w' );
- return _ioError("Can't open $fileName for write") unless $status;
- my $retval = $self->writeToFileHandle( $fh, 1 );
- $fh->close();
- $fh = undef;
-
- return $retval;
-}
-
-# It is possible to write data to the FH before calling this,
-# perhaps to make a self-extracting archive.
-sub writeToFileHandle {
- my $self = shift;
- my $fh = shift;
- return _error('No filehandle given') unless $fh;
- return _ioError('filehandle not open') unless $fh->opened();
-
- my $fhIsSeekable = @_ ? shift: _isSeekable($fh);
- _binmode($fh);
-
- # Find out where the current position is.
- my $offset = $fhIsSeekable ? $fh->tell() : 0;
- $offset = 0 if $offset < 0;
-
- foreach my $member ( $self->members() ) {
- my $retval = $member->_writeToFileHandle( $fh, $fhIsSeekable, $offset );
- $member->endRead();
- return $retval if $retval != AZ_OK;
- $offset += $member->_localHeaderSize() + $member->_writeOffset();
- $offset +=
- $member->hasDataDescriptor()
- ? DATA_DESCRIPTOR_LENGTH + SIGNATURE_LENGTH
- : 0;
-
- # changed this so it reflects the last successful position
- $self->{'writeCentralDirectoryOffset'} = $offset;
- }
- return $self->writeCentralDirectory($fh);
-}
-
-# Write zip back to the original file,
-# as safely as possible.
-# Returns AZ_OK if successful.
-sub overwrite {
- my $self = shift;
- return $self->overwriteAs( $self->{'fileName'} );
-}
-
-# Write zip to the specified file,
-# as safely as possible.
-# Returns AZ_OK if successful.
-sub overwriteAs {
- my $self = shift;
- my $zipName = shift;
- return _error("no filename in overwriteAs()") unless defined($zipName);
-
- my ( $fh, $tempName ) = Archive::Zip::tempFile();
- return _error( "Can't open temp file", $! ) unless $fh;
-
- ( my $backupName = $zipName ) =~ s{(\.[^.]*)?$}{.zbk};
-
- my $status = $self->writeToFileHandle($fh);
- $fh->close();
- $fh = undef;
-
- if ( $status != AZ_OK ) {
- unlink($tempName);
- _printError("Can't write to $tempName");
- return $status;
- }
-
- my $err;
-
- # rename the zip
- if ( -f $zipName && !rename( $zipName, $backupName ) ) {
- $err = $!;
- unlink($tempName);
- return _error( "Can't rename $zipName as $backupName", $err );
- }
-
- # move the temp to the original name (possibly copying)
- unless ( File::Copy::move( $tempName, $zipName ) ) {
- $err = $!;
- rename( $backupName, $zipName );
- unlink($tempName);
- return _error( "Can't move $tempName to $zipName", $err );
- }
-
- # unlink the backup
- if ( -f $backupName && !unlink($backupName) ) {
- $err = $!;
- return _error( "Can't unlink $backupName", $err );
- }
-
- return AZ_OK;
-}
-
-# Used only during writing
-sub _writeCentralDirectoryOffset {
- shift->{'writeCentralDirectoryOffset'};
-}
-
-sub _writeEOCDOffset {
- shift->{'writeEOCDOffset'};
-}
-
-# Expects to have _writeEOCDOffset() set
-sub _writeEndOfCentralDirectory {
- my ( $self, $fh ) = @_;
-
- $fh->print(END_OF_CENTRAL_DIRECTORY_SIGNATURE_STRING)
- or return _ioError('writing EOCD Signature');
- my $zipfileCommentLength = length( $self->zipfileComment() );
-
- my $header = pack(
- END_OF_CENTRAL_DIRECTORY_FORMAT,
- 0, # {'diskNumber'},
- 0, # {'diskNumberWithStartOfCentralDirectory'},
- $self->numberOfMembers(), # {'numberOfCentralDirectoriesOnThisDisk'},
- $self->numberOfMembers(), # {'numberOfCentralDirectories'},
- $self->_writeEOCDOffset() - $self->_writeCentralDirectoryOffset(),
- $self->_writeCentralDirectoryOffset(),
- $zipfileCommentLength
- );
- $fh->print($header)
- or return _ioError('writing EOCD header');
- if ($zipfileCommentLength) {
- $fh->print( $self->zipfileComment() )
- or return _ioError('writing zipfile comment');
- }
- return AZ_OK;
-}
-
-# $offset can be specified to truncate a zip file.
-sub writeCentralDirectory {
- my ( $self, $fh, $offset ) = @_;
-
- if ( defined($offset) ) {
- $self->{'writeCentralDirectoryOffset'} = $offset;
- $fh->seek( $offset, IO::Seekable::SEEK_SET )
- or return _ioError('seeking to write central directory');
- }
- else {
- $offset = $self->_writeCentralDirectoryOffset();
- }
-
- foreach my $member ( $self->members() ) {
- my $status = $member->_writeCentralDirectoryFileHeader($fh);
- return $status if $status != AZ_OK;
- $offset += $member->_centralDirectoryHeaderSize();
- $self->{'writeEOCDOffset'} = $offset;
- }
- return $self->_writeEndOfCentralDirectory($fh);
-}
-
-sub read {
- my $self = shift;
- my $fileName = shift;
- return _error('No filename given') unless $fileName;
- my ( $status, $fh ) = _newFileHandle( $fileName, 'r' );
- return _ioError("opening $fileName for read") unless $status;
-
- $status = $self->readFromFileHandle( $fh, $fileName );
- return $status if $status != AZ_OK;
-
- $fh->close();
- $self->{'fileName'} = $fileName;
- return AZ_OK;
-}
-
-sub readFromFileHandle {
- my $self = shift;
- my $fh = shift;
- my $fileName = shift;
- $fileName = $fh unless defined($fileName);
- return _error('No filehandle given') unless $fh;
- return _ioError('filehandle not open') unless $fh->opened();
-
- _binmode($fh);
- $self->{'fileName'} = "$fh";
-
- # TODO: how to support non-seekable zips?
- return _error('file not seekable')
- unless _isSeekable($fh);
-
- $fh->seek( 0, 0 ); # rewind the file
-
- my $status = $self->_findEndOfCentralDirectory($fh);
- return $status if $status != AZ_OK;
-
- my $eocdPosition = $fh->tell();
-
- $status = $self->_readEndOfCentralDirectory($fh);
- return $status if $status != AZ_OK;
-
- $fh->seek( $eocdPosition - $self->centralDirectorySize(),
- IO::Seekable::SEEK_SET )
- or return _ioError("Can't seek $fileName");
-
- # Try to detect garbage at beginning of archives
- # This should be 0
- $self->{'eocdOffset'} = $eocdPosition - $self->centralDirectorySize() # here
- - $self->centralDirectoryOffsetWRTStartingDiskNumber();
-
- for ( ; ; ) {
- my $newMember =
- $self->ZIPMEMBERCLASS->_newFromZipFile( $fh, $fileName,
- $self->eocdOffset() );
- my $signature;
- ( $status, $signature ) = _readSignature( $fh, $fileName );
- return $status if $status != AZ_OK;
- last if $signature == END_OF_CENTRAL_DIRECTORY_SIGNATURE;
- $status = $newMember->_readCentralDirectoryFileHeader();
- return $status if $status != AZ_OK;
- $status = $newMember->endRead();
- return $status if $status != AZ_OK;
- $newMember->_becomeDirectoryIfNecessary();
- push( @{ $self->{'members'} }, $newMember );
- }
-
- return AZ_OK;
-}
-
-# Read EOCD, starting from position before signature.
-# Return AZ_OK on success.
-sub _readEndOfCentralDirectory {
- my $self = shift;
- my $fh = shift;
-
- # Skip past signature
- $fh->seek( SIGNATURE_LENGTH, IO::Seekable::SEEK_CUR )
- or return _ioError("Can't seek past EOCD signature");
-
- my $header = '';
- my $bytesRead = $fh->read( $header, END_OF_CENTRAL_DIRECTORY_LENGTH );
- if ( $bytesRead != END_OF_CENTRAL_DIRECTORY_LENGTH ) {
- return _ioError("reading end of central directory");
- }
-
- my $zipfileCommentLength;
- (
- $self->{'diskNumber'},
- $self->{'diskNumberWithStartOfCentralDirectory'},
- $self->{'numberOfCentralDirectoriesOnThisDisk'},
- $self->{'numberOfCentralDirectories'},
- $self->{'centralDirectorySize'},
- $self->{'centralDirectoryOffsetWRTStartingDiskNumber'},
- $zipfileCommentLength
- ) = unpack( END_OF_CENTRAL_DIRECTORY_FORMAT, $header );
-
- if ($zipfileCommentLength) {
- my $zipfileComment = '';
- $bytesRead = $fh->read( $zipfileComment, $zipfileCommentLength );
- if ( $bytesRead != $zipfileCommentLength ) {
- return _ioError("reading zipfile comment");
- }
- $self->{'zipfileComment'} = $zipfileComment;
- }
-
- return AZ_OK;
-}
-
-# Seek in my file to the end, then read backwards until we find the
-# signature of the central directory record. Leave the file positioned right
-# before the signature. Returns AZ_OK if success.
-sub _findEndOfCentralDirectory {
- my $self = shift;
- my $fh = shift;
- my $data = '';
- $fh->seek( 0, IO::Seekable::SEEK_END )
- or return _ioError("seeking to end");
-
- my $fileLength = $fh->tell();
- if ( $fileLength < END_OF_CENTRAL_DIRECTORY_LENGTH + 4 ) {
- return _formatError("file is too short");
- }
-
- my $seekOffset = 0;
- my $pos = -1;
- for ( ; ; ) {
- $seekOffset += 512;
- $seekOffset = $fileLength if ( $seekOffset > $fileLength );
- $fh->seek( -$seekOffset, IO::Seekable::SEEK_END )
- or return _ioError("seek failed");
- my $bytesRead = $fh->read( $data, $seekOffset );
- if ( $bytesRead != $seekOffset ) {
- return _ioError("read failed");
- }
- $pos = rindex( $data, END_OF_CENTRAL_DIRECTORY_SIGNATURE_STRING );
- last
- if ( $pos >= 0
- or $seekOffset == $fileLength
- or $seekOffset >= $Archive::Zip::ChunkSize );
- }
-
- if ( $pos >= 0 ) {
- $fh->seek( $pos - $seekOffset, IO::Seekable::SEEK_CUR )
- or return _ioError("seeking to EOCD");
- return AZ_OK;
- }
- else {
- return _formatError("can't find EOCD signature");
- }
-}
-
-# Used to avoid taint problems when chdir'ing.
-# Not intended to increase security in any way; just intended to shut up the -T
-# complaints. If your Cwd module is giving you unreliable returns from cwd()
-# you have bigger problems than this.
-sub _untaintDir {
- my $dir = shift;
- $dir =~ m/\A(.+)\z/s;
- return $1;
-}
-
-sub addTree {
- my $self = shift;
- my $root = shift or return _error("root arg missing in call to addTree()");
- my $dest = shift;
- $dest = '' unless defined($dest);
- my $pred = shift || sub { -r };
- my @files;
- my $startDir = _untaintDir( cwd() );
-
- return _error( 'undef returned by _untaintDir on cwd ', cwd() )
- unless $startDir;
-
- # This avoids chdir'ing in Find, in a way compatible with older
- # versions of File::Find.
- my $wanted = sub {
- local $main::_ = $File::Find::name;
- my $dir = _untaintDir($File::Find::dir);
- chdir($startDir);
- push( @files, $File::Find::name ) if (&$pred);
- chdir($dir);
- };
-
- File::Find::find( $wanted, $root );
-
- my $rootZipName = _asZipDirName( $root, 1 ); # with trailing slash
- my $pattern = $rootZipName eq './' ? '^' : "^\Q$rootZipName\E";
-
- $dest = _asZipDirName( $dest, 1 ); # with trailing slash
-
- foreach my $fileName (@files) {
- my $isDir = -d $fileName;
-
- # normalize, remove leading ./
- my $archiveName = _asZipDirName( $fileName, $isDir );
- if ( $archiveName eq $rootZipName ) { $archiveName = $dest }
- else { $archiveName =~ s{$pattern}{$dest} }
- next if $archiveName =~ m{^\.?/?$}; # skip current dir
- my $member = $isDir
- ? $self->addDirectory( $fileName, $archiveName )
- : $self->addFile( $fileName, $archiveName );
- return _error("add $fileName failed in addTree()") if !$member;
- }
- return AZ_OK;
-}
-
-sub addTreeMatching {
- my $self = shift;
- my $root = shift
- or return _error("root arg missing in call to addTreeMatching()");
- my $dest = shift;
- $dest = '' unless defined($dest);
- my $pattern = shift
- or return _error("pattern missing in call to addTreeMatching()");
- my $pred = shift;
- my $matcher =
- $pred ? sub { m{$pattern} && &$pred } : sub { m{$pattern} && -r };
- return $self->addTree( $root, $dest, $matcher );
-}
-
-# $zip->extractTree( $root, $dest [, $volume] );
-#
-# $root and $dest are Unix-style.
-# $volume is in local FS format.
-#
-sub extractTree {
- my $self = shift;
- my $root = shift; # Zip format
- $root = '' unless defined($root);
- my $dest = shift; # Zip format
- $dest = './' unless defined($dest);
- my $volume = shift; # optional
- my $pattern = "^\Q$root";
- my @members = $self->membersMatching($pattern);
-
- foreach my $member (@members) {
- my $fileName = $member->fileName(); # in Unix format
- $fileName =~ s{$pattern}{$dest}; # in Unix format
- # convert to platform format:
- $fileName = Archive::Zip::_asLocalName( $fileName, $volume );
- my $status = $member->extractToFileNamed($fileName);
- return $status if $status != AZ_OK;
- }
- return AZ_OK;
-}
-
-# $zip->updateMember( $memberOrName, $fileName );
-# Returns (possibly updated) member, if any; undef on errors.
-
-sub updateMember {
- my $self = shift;
- my $oldMember = shift;
- my $fileName = shift;
-
- if ( !defined($fileName) ) {
- _error("updateMember(): missing fileName argument");
- return undef;
- }
-
- my @newStat = stat($fileName);
- if ( !@newStat ) {
- _ioError("Can't stat $fileName");
- return undef;
- }
-
- my $isDir = -d _;
-
- my $memberName;
-
- if ( ref($oldMember) ) {
- $memberName = $oldMember->fileName();
- }
- else {
- $oldMember = $self->memberNamed( $memberName = $oldMember )
- || $self->memberNamed( $memberName =
- _asZipDirName( $oldMember, $isDir ) );
- }
-
- unless ( defined($oldMember)
- && $oldMember->lastModTime() == $newStat[9]
- && $oldMember->isDirectory() == $isDir
- && ( $isDir || ( $oldMember->uncompressedSize() == $newStat[7] ) ) )
- {
-
- # create the new member
- my $newMember = $isDir
- ? $self->ZIPMEMBERCLASS->newDirectoryNamed( $fileName, $memberName )
- : $self->ZIPMEMBERCLASS->newFromFile( $fileName, $memberName );
-
- unless ( defined($newMember) ) {
- _error("creation of member $fileName failed in updateMember()");
- return undef;
- }
-
- # replace old member or append new one
- if ( defined($oldMember) ) {
- $self->replaceMember( $oldMember, $newMember );
- }
- else { $self->addMember($newMember); }
-
- return $newMember;
- }
-
- return $oldMember;
-}
-
-# $zip->updateTree( $root, [ $dest, [ $pred [, $mirror]]] );
-#
-# This takes the same arguments as addTree, but first checks to see
-# whether the file or directory already exists in the zip file.
-#
-# If the fourth argument $mirror is true, then delete all my members
-# if corresponding files weren't found.
-
-sub updateTree {
- my $self = shift;
- my $root = shift
- or return _error("root arg missing in call to updateTree()");
- my $dest = shift;
- $dest = '' unless defined($dest);
- $dest = _asZipDirName( $dest, 1 );
- my $pred = shift || sub { -r };
- my $mirror = shift;
-
- my $rootZipName = _asZipDirName( $root, 1 ); # with trailing slash
- my $pattern = $rootZipName eq './' ? '^' : "^\Q$rootZipName\E";
-
- my @files;
- my $startDir = _untaintDir( cwd() );
-
- return _error( 'undef returned by _untaintDir on cwd ', cwd() )
- unless $startDir;
-
- # This avoids chdir'ing in Find, in a way compatible with older
- # versions of File::Find.
- my $wanted = sub {
- local $main::_ = $File::Find::name;
- my $dir = _untaintDir($File::Find::dir);
- chdir($startDir);
- push( @files, $File::Find::name ) if (&$pred);
- chdir($dir);
- };
-
- File::Find::find( $wanted, $root );
-
- # Now @files has all the files that I could potentially be adding to
- # the zip. Only add the ones that are necessary.
- # For each file (updated or not), add its member name to @done.
- my %done;
- foreach my $fileName (@files) {
- my @newStat = stat($fileName);
- my $isDir = -d _;
-
- # normalize, remove leading ./
- my $memberName = _asZipDirName( $fileName, $isDir );
- if ( $memberName eq $rootZipName ) { $memberName = $dest }
- else { $memberName =~ s{$pattern}{$dest} }
- next if $memberName =~ m{^\.?/?$}; # skip current dir
-
- $done{$memberName} = 1;
- my $changedMember = $self->updateMember( $memberName, $fileName );
- return _error("updateTree failed to update $fileName")
- unless ref($changedMember);
- }
-
- # @done now has the archive names corresponding to all the found files.
- # If we're mirroring, delete all those members that aren't in @done.
- if ($mirror) {
- foreach my $member ( $self->members() ) {
- $self->removeMember($member)
- unless $done{ $member->fileName() };
- }
- }
-
- return AZ_OK;
-}
-
-1;
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Archive/Zip/BufferedFileHandle.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Archive/Zip/BufferedFileHandle.pm
deleted file mode 100644
index 0134d60c2b4..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Archive/Zip/BufferedFileHandle.pm
+++ /dev/null
@@ -1,131 +0,0 @@
-package Archive::Zip::BufferedFileHandle;
-
-# File handle that uses a string internally and can seek
-# This is given as a demo for getting a zip file written
-# to a string.
-# I probably should just use IO::Scalar instead.
-# Ned Konz, March 2000
-
-use strict;
-use IO::File;
-use Carp;
-
-use vars qw{$VERSION};
-
-BEGIN {
- $VERSION = '1.23';
- $VERSION = eval $VERSION;
-}
-
-sub new {
- my $class = shift || __PACKAGE__;
- $class = ref($class) || $class;
- my $self = bless(
- {
- content => '',
- position => 0,
- size => 0
- },
- $class
- );
- return $self;
-}
-
-# Utility method to read entire file
-sub readFromFile {
- my $self = shift;
- my $fileName = shift;
- my $fh = IO::File->new( $fileName, "r" );
- CORE::binmode($fh);
- if ( !$fh ) {
- Carp::carp("Can't open $fileName: $!\n");
- return undef;
- }
- local $/ = undef;
- $self->{content} = <$fh>;
- $self->{size} = length( $self->{content} );
- return $self;
-}
-
-sub contents {
- my $self = shift;
- if (@_) {
- $self->{content} = shift;
- $self->{size} = length( $self->{content} );
- }
- return $self->{content};
-}
-
-sub binmode { 1 }
-
-sub close { 1 }
-
-sub opened { 1 }
-
-sub eof {
- my $self = shift;
- return $self->{position} >= $self->{size};
-}
-
-sub seek {
- my $self = shift;
- my $pos = shift;
- my $whence = shift;
-
- # SEEK_SET
- if ( $whence == 0 ) { $self->{position} = $pos; }
-
- # SEEK_CUR
- elsif ( $whence == 1 ) { $self->{position} += $pos; }
-
- # SEEK_END
- elsif ( $whence == 2 ) { $self->{position} = $self->{size} + $pos; }
- else { return 0; }
-
- return 1;
-}
-
-sub tell { return shift->{position}; }
-
-# Copy my data to given buffer
-sub read {
- my $self = shift;
- my $buf = \( $_[0] );
- shift;
- my $len = shift;
- my $offset = shift || 0;
-
- $$buf = '' if not defined($$buf);
- my $bytesRead =
- ( $self->{position} + $len > $self->{size} )
- ? ( $self->{size} - $self->{position} )
- : $len;
- substr( $$buf, $offset, $bytesRead ) =
- substr( $self->{content}, $self->{position}, $bytesRead );
- $self->{position} += $bytesRead;
- return $bytesRead;
-}
-
-# Copy given buffer to me
-sub write {
- my $self = shift;
- my $buf = \( $_[0] );
- shift;
- my $len = shift;
- my $offset = shift || 0;
-
- $$buf = '' if not defined($$buf);
- my $bufLen = length($$buf);
- my $bytesWritten =
- ( $offset + $len > $bufLen )
- ? $bufLen - $offset
- : $len;
- substr( $self->{content}, $self->{position}, $bytesWritten ) =
- substr( $$buf, $offset, $bytesWritten );
- $self->{size} = length( $self->{content} );
- return $bytesWritten;
-}
-
-sub clearerr() { 1 }
-
-1;
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Archive/Zip/DirectoryMember.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Archive/Zip/DirectoryMember.pm
deleted file mode 100644
index eab8286b302..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Archive/Zip/DirectoryMember.pm
+++ /dev/null
@@ -1,82 +0,0 @@
-package Archive::Zip::DirectoryMember;
-
-use strict;
-use File::Path;
-
-use vars qw( $VERSION @ISA );
-
-BEGIN {
- $VERSION = '1.23';
- @ISA = qw( Archive::Zip::Member );
-}
-
-use Archive::Zip qw(
- :ERROR_CODES
- :UTILITY_METHODS
-);
-
-sub _newNamed {
- my $class = shift;
- my $fileName = shift; # FS name
- my $newName = shift; # Zip name
- $newName = _asZipDirName($fileName) unless $newName;
- my $self = $class->new(@_);
- $self->{'externalFileName'} = $fileName;
- $self->fileName($newName);
-
- if ( -e $fileName ) {
-
- # -e does NOT do a full stat, so we need to do one now
- if ( -d _ ) {
- my @stat = stat(_);
- $self->unixFileAttributes( $stat[2] );
- my $mod_t = $stat[9];
- if ( $^O eq 'MSWin32' and !$mod_t ) {
- $mod_t = time();
- }
- $self->setLastModFileDateTimeFromUnix($mod_t);
-
- }
- else { # hmm.. trying to add a non-directory?
- _error( $fileName, ' exists but is not a directory' );
- return undef;
- }
- }
- else {
- $self->unixFileAttributes( $self->DEFAULT_DIRECTORY_PERMISSIONS );
- $self->setLastModFileDateTimeFromUnix( time() );
- }
- return $self;
-}
-
-sub externalFileName {
- shift->{'externalFileName'};
-}
-
-sub isDirectory {
- return 1;
-}
-
-sub extractToFileNamed {
- my $self = shift;
- my $name = shift; # local FS name
- my $attribs = $self->unixFileAttributes() & 07777;
- mkpath( $name, 0, $attribs ); # croaks on error
- utime( $self->lastModTime(), $self->lastModTime(), $name );
- return AZ_OK;
-}
-
-sub fileName {
- my $self = shift;
- my $newName = shift;
- $newName =~ s{/?$}{/} if defined($newName);
- return $self->SUPER::fileName($newName);
-}
-
-# So people don't get too confused. This way it looks like the problem
-# is in their code...
-sub contents {
- return wantarray ? ( undef, AZ_OK ) : undef;
-}
-
-1;
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Archive/Zip/FAQ.pod b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Archive/Zip/FAQ.pod
deleted file mode 100644
index 2d2e1ab408d..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Archive/Zip/FAQ.pod
+++ /dev/null
@@ -1,467 +0,0 @@
-
-=head1 NAME
-
-
-Archive::Zip::FAQ - Answers to a few frequently asked questions about Archive::Zip
-
-=head1 DESCRIPTION
-
-
-It seems that I keep answering the same questions over and over again. I
-assume that this is because my documentation is deficient, rather than that
-people don't read the documentation.
-
-
-So this FAQ is an attempt to cut down on the number of personal answers I have
-to give. At least I can now say "You I<did> read the FAQ, right?".
-
-
-The questions are not in any particular order. The answers assume the current
-version of Archive::Zip; some of the answers depend on newly added/fixed
-functionality.
-
-=head1 Install problems on RedHat 8 or 9 with Perl 5.8.0
-
-
-B<Q:> Archive::Zip won't install on my RedHat 9 system! It's broke!
-
-
-B<A:> This has become something of a FAQ.
-Basically, RedHat broke some versions of Perl by setting LANG to UTF8.
-They apparently have a fixed version out as an update.
-
-You might try running CPAN or creating your Makefile after exporting the LANG
-environment variable as
-
-C<LANG=C>
-
-L<https://bugzilla.redhat.com/bugzilla/show_bug.cgi?id=87682>
-
-
-=head1 Why is my zip file so big?
-
-
-B<Q:> My zip file is actually bigger than what I stored in it! Why?
-
-
-B<A:> Some things to make sure of:
-
-=over 4
-
-=item Make sure that you are requesting COMPRESSION_DEFLATED if you are storing strings.
-
-
-
-
-$member->desiredCompressionMethod( COMPRESSION_DEFLATED );
-
-
-=item Don't make lots of little files if you can help it.
-
-
-
-Since zip computes the compression tables for each member, small
-members without much entropy won't compress well. Instead, if you've
-got lots of repeated strings in your data, try to combine them into
-one big member.
-
-
-=item Make sure that you are requesting COMPRESSION_STORED if you are storing things that are already compressed.
-
-
-
-If you're storing a .zip, .jpg, .mp3, or other compressed file in a zip,
-then don't compress them again. They'll get bigger.
-
-=back
-
-=head1 Sample code?
-
-
-B<Q:> Can you send me code to do (whatever)?
-
-
-B<A:> Have you looked in the C<examples/> directory yet? It contains:
-
-=over 4
-
-=item examples/calcSizes.pl -- How to find out how big a Zip file will be before writing it
-
-
-
-=item examples/copy.pl -- Copies one Zip file to another
-
-
-
-=item examples/extract.pl -- extract file(s) from a Zip
-
-
-
-=item examples/mailZip.pl -- make and mail a zip file
-
-
-
-=item examples/mfh.pl -- demo for use of MockFileHandle
-
-
-
-=item examples/readScalar.pl -- shows how to use IO::Scalar as the source of a Zip read
-
-
-
-=item examples/selfex.pl -- a brief example of a self-extracting Zip
-
-
-
-=item examples/unzipAll.pl -- uses Archive::Zip::Tree to unzip an entire Zip
-
-
-
-=item examples/updateZip.pl -- shows how to read/modify/write a Zip
-
-
-
-=item examples/updateTree.pl -- shows how to update a Zip in place
-
-
-
-=item examples/writeScalar.pl -- shows how to use IO::Scalar as the destination of a Zip write
-
-
-
-=item examples/writeScalar2.pl -- shows how to use IO::String as the destination of a Zip write
-
-
-
-=item examples/zip.pl -- Constructs a Zip file
-
-
-
-=item examples/zipcheck.pl -- One way to check a Zip file for validity
-
-
-
-=item examples/zipinfo.pl -- Prints out information about a Zip archive file
-
-
-
-=item examples/zipGrep.pl -- Searches for text in Zip files
-
-
-
-=item examples/ziptest.pl -- Lists a Zip file and checks member CRCs
-
-
-
-=item examples/ziprecent.pl -- Puts recent files into a zipfile
-
-
-
-=item examples/ziptest.pl -- Another way to check a Zip file for validity
-
-
-
-=back
-
-=head1 Can't Read/modify/write same Zip file
-
-
-B<Q:> Why can't I open a Zip file, add a member, and write it back? I get an
-error message when I try.
-
-
-B<A:> Because Archive::Zip doesn't (and can't, generally) read file contents into memory,
-the original Zip file is required to stay around until the writing of the new
-file is completed.
-
-
-The best way to do this is to write the Zip to a temporary file and then
-rename the temporary file to have the old name (possibly after deleting the
-old one).
-
-
-Archive::Zip v1.02 added the archive methods C<overwrite()> and
-C<overwriteAs()> to do this simply and carefully.
-
-
-See C<examples/updateZip.pl> for an example of this technique.
-
-=head1 File creation time not set
-
-
-B<Q:> Upon extracting files, I see that their modification (and access) times are
-set to the time in the Zip archive. However, their creation time is not set to
-the same time. Why?
-
-
-B<A:> Mostly because Perl doesn't give cross-platform access to I<creation time>.
-Indeed, many systems (like Unix) don't support such a concept.
-However, if yours does, you can easily set it. Get the modification time from
-the member using C<lastModTime()>.
-
-=head1 Can't use Archive::Zip on gzip files
-
-
-B<Q:> Can I use Archive::Zip to extract Unix gzip files?
-
-
-B<A:> No.
-
-
-There is a distinction between Unix gzip files, and Zip archives that
-also can use the gzip compression.
-
-
-Depending on the format of the gzip file, you can use L<Compress::Zlib>, or
-L<Archive::Tar> to decompress it (and de-archive it in the case of Tar files).
-
-
-You can unzip PKZIP/WinZip/etc/ archives using Archive::Zip (that's what
-it's for) as long as any compressed members are compressed using
-Deflate compression.
-
-=head1 Add a directory/tree to a Zip
-
-
-B<Q:> How can I add a directory (or tree) full of files to a Zip?
-
-
-B<A:> You can use the Archive::Zip::addTree*() methods:
-
- use Archive::Zip;
- my $zip = Archive::Zip->new();
- # add all readable files and directories below . as xyz/*
- $zip->addTree( '.', 'xyz' );
- # add all readable plain files below /abc as def/*
- $zip->addTree( '/abc', 'def', sub { -f && -r } );
- # add all .c files below /tmp as stuff/*
- $zip->addTreeMatching( '/tmp', 'stuff', '\.c$' );
- # add all .o files below /tmp as stuff/* if they aren't writable
- $zip->addTreeMatching( '/tmp', 'stuff', '\.o$', sub { ! -w } );
- # add all .so files below /tmp that are smaller than 200 bytes as stuff/*
- $zip->addTreeMatching( '/tmp', 'stuff', '\.o$', sub { -s < 200 } );
- # and write them into a file
- $zip->writeToFileNamed('xxx.zip');
-
-=head1 Extract a directory/tree
-
-
-B<Q:> How can I extract some (or all) files from a Zip into a different
-directory?
-
-
-B<A:> You can use the Archive::Zip::extractTree() method:
-??? ||
-
-
- # now extract the same files into /tmpx
- $zip->extractTree( 'stuff', '/tmpx' );
-
-=head1 Update a directory/tree
-
-
-B<Q:> How can I update a Zip from a directory tree, adding or replacing only
-the newer files?
-
-
-B<A:> You can use the Archive::Zip::updateTree() method that was added in version 1.09.
-
-=head1 Zip times might be off by 1 second
-
-
-B<Q:> It bothers me greatly that my file times are wrong by one second about half
-the time. Why don't you do something about it?
-
-
-B<A:> Get over it. This is a result of the Zip format storing times in DOS
-format, which has a resolution of only two seconds.
-
-=head1 Zip times don't include time zone information
-
-
-B<Q:> My file times don't respect time zones. What gives?
-
-
-B<A:> If this is important to you, please submit patches to read the various
-Extra Fields that encode times with time zones. I'm just using the DOS
-Date/Time, which doesn't have a time zone.
-
-=head1 How do I make a self-extracting Zip
-
-
-B<Q:> I want to make a self-extracting Zip file. Can I do this?
-
-
-B<A:> Yes. You can write a self-extracting archive stub (that is, a version of
-unzip) to the output filehandle that you pass to writeToFileHandle(). See
-examples/selfex.pl for how to write a self-extracting archive.
-
-
-However, you should understand that this will only work on one kind of
-platform (the one for which the stub was compiled).
-
-=head1 How can I deal with Zips with prepended garbage (i.e. from Sircam)
-
-
-B<Q:> How can I tell if a Zip has been damaged by adding garbage to the
-beginning or inside the file?
-
-
-B<A:> I added code for this for the Amavis virus scanner. You can query archives
-for their 'eocdOffset' property, which should be 0:
-
-
- if ($zip->eocdOffset > 0)
- { warn($zip->eocdOffset . " bytes of garbage at beginning or within Zip") }
-
-
-When members are extracted, this offset will be used to adjust the start of
-the member if necessary.
-
-=head1 Can't extract Shrunk files
-
-
-B<Q:> I'm trying to extract a file out of a Zip produced by PKZIP, and keep
-getting this error message:
-
-
- error: Unsupported compression combination: read 6, write 0
-
-
-B<A:> You can't uncompress this archive member. Archive::Zip only supports uncompressed
-members, and compressed members that are compressed using the compression
-supported by Compress::Zlib. That means only Deflated and Stored members.
-
-
-Your file is compressed using the Shrink format, which isn't supported by
-Compress::Zlib.
-
-
-You could, perhaps, use a command-line UnZip program (like the Info-Zip
-one) to extract this.
-
-=head1 Can't do decryption
-
-
-B<Q:> How do I decrypt encrypted Zip members?
-
-
-B<A:> With some other program or library. Archive::Zip doesn't support decryption,
-and probably never will (unless I<you> write it).
-
-=head1 How to test file integrity?
-
-
-B<Q:> How can Archive::Zip can test the validity of a Zip file?
-
-
-B<A:> If you try to decompress the file, the gzip streams will report errors
-if you have garbage. Most of the time.
-
-If you try to open the file and a central directory structure can't be
-found, an error will be reported.
-
-When a file is being read, if we can't find a proper PK.. signature in
-the right places we report a format error.
-
-If there is added garbage at the beginning of a Zip file (as inserted
-by some viruses), you can find out about it, but Archive::Zip will ignore it,
-and you can still use the archive. When it gets written back out the
-added stuff will be gone.
-
-
-There are two ready-to-use utilities in the examples directory that can
-be used to test file integrity, or that you can use as examples
-for your own code:
-
-=over 4
-
-=item examples/zipcheck.pl shows how to use an attempted extraction to test a file.
-
-
-
-=item examples/ziptest.pl shows how to test CRCs in a file.
-
-
-
-=back
-
-=head1 Duplicate files in Zip?
-
-
-B<Q:> Archive::Zip let me put the same file in my Zip twice! Why don't you prevent this?
-
-
-B<A:> As far as I can tell, this is not disallowed by the Zip spec. If you
-think it's a bad idea, check for it yourself:
-
-
- $zip->addFile($someFile, $someName) unless $zip->memberNamed($someName);
-
-
-I can even imagine cases where this might be useful (for instance, multiple
-versions of files).
-
-=head1 File ownership/permissions/ACLS/etc
-
-
-B<Q:> Why doesn't Archive::Zip deal with file ownership, ACLs, etc.?
-
-
-B<A:> There is no standard way to represent these in the Zip file format. If
-you want to send me code to properly handle the various extra fields that
-have been used to represent these through the years, I'll look at it.
-
-=head1 I can't compile but ActiveState only has an old version of Archive::Zip
-
-
-B<Q:> I've only installed modules using ActiveState's PPM program and
-repository. But they have a much older version of Archive::Zip than is in CPAN. Will
-you send me a newer PPM?
-
-
-B<A:> Probably not, unless I get lots of extra time. But there's no reason you
-can't install the version from CPAN. Archive::Zip is pure Perl, so all you need is
-NMAKE, which you can get for free from Microsoft (see the FAQ in the
-ActiveState documentation for details on how to install CPAN modules).
-
-=head1 My JPEGs (or MP3's) don't compress when I put them into Zips!
-
-
-B<Q:> How come my JPEGs and MP3's don't compress much when I put them into Zips?
-
-
-B<A:> Because they're already compressed.
-
-=head1 Under Windows, things lock up/get damaged
-
-
-B<Q:> I'm using Windows. When I try to use Archive::Zip, my machine locks up/makes
-funny sounds/displays a BSOD/corrupts data. How can I fix this?
-
-
-B<A:> First, try the newest version of Compress::Zlib. I know of
-Windows-related problems prior to v1.14 of that library.
-
-
-If that doesn't get rid of the problem, fix your computer or get rid of
-Windows.
-
-=head1 Zip contents in a scalar
-
-
-B<Q:> I want to read a Zip file from (or write one to) a scalar variable instead
-of a file. How can I do this?
-
-
-B<A:> Use C<IO::String> and the C<readFromFileHandle()> and
-C<writeToFileHandle()> methods.
-See C<examples/readScalar.pl> and C<examples/writeScalar.pl>.
-
-=head1 Reading from streams
-
-
-B<Q:> How do I read from a stream (like for the Info-Zip C<funzip> program)?
-
-
-B<A:> This isn't currently supported, though writing to a stream is.
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Archive/Zip/FileMember.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Archive/Zip/FileMember.pm
deleted file mode 100644
index cb0b72e218b..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Archive/Zip/FileMember.pm
+++ /dev/null
@@ -1,64 +0,0 @@
-package Archive::Zip::FileMember;
-
-use strict;
-use vars qw( $VERSION @ISA );
-
-BEGIN {
- $VERSION = '1.23';
- @ISA = qw ( Archive::Zip::Member );
-}
-
-use Archive::Zip qw(
- :UTILITY_METHODS
-);
-
-sub externalFileName {
- shift->{'externalFileName'};
-}
-
-# Return true if I depend on the named file
-sub _usesFileNamed {
- my $self = shift;
- my $fileName = shift;
- my $xfn = $self->externalFileName();
- return undef if ref($xfn);
- return $xfn eq $fileName;
-}
-
-sub fh {
- my $self = shift;
- $self->_openFile()
- if !defined( $self->{'fh'} ) || !$self->{'fh'}->opened();
- return $self->{'fh'};
-}
-
-# opens my file handle from my file name
-sub _openFile {
- my $self = shift;
- my ( $status, $fh ) = _newFileHandle( $self->externalFileName(), 'r' );
- if ( !$status ) {
- _ioError( "Can't open", $self->externalFileName() );
- return undef;
- }
- $self->{'fh'} = $fh;
- _binmode($fh);
- return $fh;
-}
-
-# Make sure I close my file handle
-sub endRead {
- my $self = shift;
- undef $self->{'fh'}; # _closeFile();
- return $self->SUPER::endRead(@_);
-}
-
-sub _become {
- my $self = shift;
- my $newClass = shift;
- return $self if ref($self) eq $newClass;
- delete( $self->{'externalFileName'} );
- delete( $self->{'fh'} );
- return $self->SUPER::_become($newClass);
-}
-
-1;
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Archive/Zip/Member.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Archive/Zip/Member.pm
deleted file mode 100644
index 1cc6ff1e15e..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Archive/Zip/Member.pm
+++ /dev/null
@@ -1,951 +0,0 @@
-package Archive::Zip::Member;
-
-# A generic membet of an archive
-
-use strict;
-use vars qw( $VERSION @ISA );
-
-BEGIN {
- $VERSION = '1.23';
- @ISA = qw( Archive::Zip );
-}
-
-use Archive::Zip qw(
- :CONSTANTS
- :MISC_CONSTANTS
- :ERROR_CODES
- :PKZIP_CONSTANTS
- :UTILITY_METHODS
-);
-
-use Time::Local ();
-use Compress::Zlib qw( Z_OK Z_STREAM_END MAX_WBITS );
-use File::Path;
-use File::Basename;
-
-use constant ZIPFILEMEMBERCLASS => 'Archive::Zip::ZipFileMember';
-use constant NEWFILEMEMBERCLASS => 'Archive::Zip::NewFileMember';
-use constant STRINGMEMBERCLASS => 'Archive::Zip::StringMember';
-use constant DIRECTORYMEMBERCLASS => 'Archive::Zip::DirectoryMember';
-
-# Unix perms for default creation of files/dirs.
-use constant DEFAULT_DIRECTORY_PERMISSIONS => 040755;
-use constant DEFAULT_FILE_PERMISSIONS => 0100666;
-use constant DIRECTORY_ATTRIB => 040000;
-use constant FILE_ATTRIB => 0100000;
-
-# Returns self if successful, else undef
-# Assumes that fh is positioned at beginning of central directory file header.
-# Leaves fh positioned immediately after file header or EOCD signature.
-sub _newFromZipFile {
- my $class = shift;
- my $self = $class->ZIPFILEMEMBERCLASS->_newFromZipFile(@_);
- return $self;
-}
-
-sub newFromString {
- my $class = shift;
- my $self = $class->STRINGMEMBERCLASS->_newFromString(@_);
- return $self;
-}
-
-sub newFromFile {
- my $class = shift;
- my $self = $class->NEWFILEMEMBERCLASS->_newFromFileNamed(@_);
- return $self;
-}
-
-sub newDirectoryNamed {
- my $class = shift;
- my $self = $class->DIRECTORYMEMBERCLASS->_newNamed(@_);
- return $self;
-}
-
-sub new {
- my $class = shift;
- my $self = {
- 'lastModFileDateTime' => 0,
- 'fileAttributeFormat' => FA_UNIX,
- 'versionMadeBy' => 20,
- 'versionNeededToExtract' => 20,
- 'bitFlag' => 0,
- 'compressionMethod' => COMPRESSION_STORED,
- 'desiredCompressionMethod' => COMPRESSION_STORED,
- 'desiredCompressionLevel' => COMPRESSION_LEVEL_NONE,
- 'internalFileAttributes' => 0,
- 'externalFileAttributes' => 0, # set later
- 'fileName' => '',
- 'cdExtraField' => '',
- 'localExtraField' => '',
- 'fileComment' => '',
- 'crc32' => 0,
- 'compressedSize' => 0,
- 'uncompressedSize' => 0,
- @_
- };
- bless( $self, $class );
- $self->unixFileAttributes( $self->DEFAULT_FILE_PERMISSIONS );
- return $self;
-}
-
-sub _becomeDirectoryIfNecessary {
- my $self = shift;
- $self->_become(DIRECTORYMEMBERCLASS)
- if $self->isDirectory();
- return $self;
-}
-
-# Morph into given class (do whatever cleanup I need to do)
-sub _become {
- return bless( $_[0], $_[1] );
-}
-
-sub versionMadeBy {
- shift->{'versionMadeBy'};
-}
-
-sub fileAttributeFormat {
- ( $#_ > 0 )
- ? ( $_[0]->{'fileAttributeFormat'} = $_[1] )
- : $_[0]->{'fileAttributeFormat'};
-}
-
-sub versionNeededToExtract {
- shift->{'versionNeededToExtract'};
-}
-
-sub bitFlag {
- shift->{'bitFlag'};
-}
-
-sub compressionMethod {
- shift->{'compressionMethod'};
-}
-
-sub desiredCompressionMethod {
- my $self = shift;
- my $newDesiredCompressionMethod = shift;
- my $oldDesiredCompressionMethod = $self->{'desiredCompressionMethod'};
- if ( defined($newDesiredCompressionMethod) ) {
- $self->{'desiredCompressionMethod'} = $newDesiredCompressionMethod;
- if ( $newDesiredCompressionMethod == COMPRESSION_STORED ) {
- $self->{'desiredCompressionLevel'} = 0;
- $self->{'bitFlag'} &= ~GPBF_HAS_DATA_DESCRIPTOR_MASK;
-
- } elsif ( $oldDesiredCompressionMethod == COMPRESSION_STORED ) {
- $self->{'desiredCompressionLevel'} = COMPRESSION_LEVEL_DEFAULT;
- }
- }
- return $oldDesiredCompressionMethod;
-}
-
-sub desiredCompressionLevel {
- my $self = shift;
- my $newDesiredCompressionLevel = shift;
- my $oldDesiredCompressionLevel = $self->{'desiredCompressionLevel'};
- if ( defined($newDesiredCompressionLevel) ) {
- $self->{'desiredCompressionLevel'} = $newDesiredCompressionLevel;
- $self->{'desiredCompressionMethod'} = (
- $newDesiredCompressionLevel
- ? COMPRESSION_DEFLATED
- : COMPRESSION_STORED
- );
- }
- return $oldDesiredCompressionLevel;
-}
-
-sub fileName {
- my $self = shift;
- my $newName = shift;
- if ($newName) {
- $newName =~ s{[\\/]+}{/}g; # deal with dos/windoze problems
- $self->{'fileName'} = $newName;
- }
- return $self->{'fileName'};
-}
-
-sub lastModFileDateTime {
- my $modTime = shift->{'lastModFileDateTime'};
- $modTime =~ m/^(\d+)$/; # untaint
- return $1;
-}
-
-sub lastModTime {
- my $self = shift;
- return _dosToUnixTime( $self->lastModFileDateTime() );
-}
-
-sub setLastModFileDateTimeFromUnix {
- my $self = shift;
- my $time_t = shift;
- $self->{'lastModFileDateTime'} = _unixToDosTime($time_t);
-}
-
-sub internalFileAttributes {
- shift->{'internalFileAttributes'};
-}
-
-sub externalFileAttributes {
- shift->{'externalFileAttributes'};
-}
-
-# Convert UNIX permissions into proper value for zip file
-# NOT A METHOD!
-sub _mapPermissionsFromUnix {
- my $perms = shift;
- return $perms << 16;
-
- # TODO: map MS-DOS perms too (RHSA?)
-}
-
-# Convert ZIP permissions into Unix ones
-#
-# This was taken from Info-ZIP group's portable UnZip
-# zipfile-extraction program, version 5.50.
-# http://www.info-zip.org/pub/infozip/
-#
-# See the mapattr() function in unix/unix.c
-# See the attribute format constants in unzpriv.h
-#
-# XXX Note that there's one situation that isn't implemented
-# yet that depends on the "extra field."
-sub _mapPermissionsToUnix {
- my $self = shift;
-
- my $format = $self->{'fileAttributeFormat'};
- my $attribs = $self->{'externalFileAttributes'};
-
- my $mode = 0;
-
- if ( $format == FA_AMIGA ) {
- $attribs = $attribs >> 17 & 7; # Amiga RWE bits
- $mode = $attribs << 6 | $attribs << 3 | $attribs;
- return $mode;
- }
-
- if ( $format == FA_THEOS ) {
- $attribs &= 0xF1FFFFFF;
- if ( ( $attribs & 0xF0000000 ) != 0x40000000 ) {
- $attribs &= 0x01FFFFFF; # not a dir, mask all ftype bits
- }
- else {
- $attribs &= 0x41FFFFFF; # leave directory bit as set
- }
- }
-
- if ( $format == FA_UNIX
- || $format == FA_VAX_VMS
- || $format == FA_ACORN
- || $format == FA_ATARI_ST
- || $format == FA_BEOS
- || $format == FA_QDOS
- || $format == FA_TANDEM )
- {
- $mode = $attribs >> 16;
- return $mode if $mode != 0 or not $self->localExtraField;
-
- # warn("local extra field is: ", $self->localExtraField, "\n");
-
- # XXX This condition is not implemented
- # I'm just including the comments from the info-zip section for now.
-
- # Some (non-Info-ZIP) implementations of Zip for Unix and
- # VMS (and probably others ??) leave 0 in the upper 16-bit
- # part of the external_file_attributes field. Instead, they
- # store file permission attributes in some extra field.
- # As a work-around, we search for the presence of one of
- # these extra fields and fall back to the MSDOS compatible
- # part of external_file_attributes if one of the known
- # e.f. types has been detected.
- # Later, we might implement extraction of the permission
- # bits from the VMS extra field. But for now, the work-around
- # should be sufficient to provide "readable" extracted files.
- # (For ASI Unix e.f., an experimental remap from the e.f.
- # mode value IS already provided!)
- }
-
- # PKWARE's PKZip for Unix marks entries as FA_MSDOS, but stores the
- # Unix attributes in the upper 16 bits of the external attributes
- # field, just like Info-ZIP's Zip for Unix. We try to use that
- # value, after a check for consistency with the MSDOS attribute
- # bits (see below).
- if ( $format == FA_MSDOS ) {
- $mode = $attribs >> 16;
- }
-
- # FA_MSDOS, FA_OS2_HPFS, FA_WINDOWS_NTFS, FA_MACINTOSH, FA_TOPS20
- $attribs = !( $attribs & 1 ) << 1 | ( $attribs & 0x10 ) >> 4;
-
- # keep previous $mode setting when its "owner"
- # part appears to be consistent with DOS attribute flags!
- return $mode if ( $mode & 0700 ) == ( 0400 | $attribs << 6 );
- $mode = 0444 | $attribs << 6 | $attribs << 3 | $attribs;
- return $mode;
-}
-
-sub unixFileAttributes {
- my $self = shift;
- my $oldPerms = $self->_mapPermissionsToUnix();
- if (@_) {
- my $perms = shift;
- if ( $self->isDirectory() ) {
- $perms &= ~FILE_ATTRIB;
- $perms |= DIRECTORY_ATTRIB;
- }
- else {
- $perms &= ~DIRECTORY_ATTRIB;
- $perms |= FILE_ATTRIB;
- }
- $self->{'externalFileAttributes'} = _mapPermissionsFromUnix($perms);
- }
- return $oldPerms;
-}
-
-sub localExtraField {
- ( $#_ > 0 )
- ? ( $_[0]->{'localExtraField'} = $_[1] )
- : $_[0]->{'localExtraField'};
-}
-
-sub cdExtraField {
- ( $#_ > 0 ) ? ( $_[0]->{'cdExtraField'} = $_[1] ) : $_[0]->{'cdExtraField'};
-}
-
-sub extraFields {
- my $self = shift;
- return $self->localExtraField() . $self->cdExtraField();
-}
-
-sub fileComment {
- ( $#_ > 0 )
- ? ( $_[0]->{'fileComment'} = pack( 'C0a*', $_[1] ) )
- : $_[0]->{'fileComment'};
-}
-
-sub hasDataDescriptor {
- my $self = shift;
- if (@_) {
- my $shouldHave = shift;
- if ($shouldHave) {
- $self->{'bitFlag'} |= GPBF_HAS_DATA_DESCRIPTOR_MASK;
- }
- else {
- $self->{'bitFlag'} &= ~GPBF_HAS_DATA_DESCRIPTOR_MASK;
- }
- }
- return $self->{'bitFlag'} & GPBF_HAS_DATA_DESCRIPTOR_MASK;
-}
-
-sub crc32 {
- shift->{'crc32'};
-}
-
-sub crc32String {
- sprintf( "%08x", shift->{'crc32'} );
-}
-
-sub compressedSize {
- shift->{'compressedSize'};
-}
-
-sub uncompressedSize {
- shift->{'uncompressedSize'};
-}
-
-sub isEncrypted {
- shift->bitFlag() & GPBF_ENCRYPTED_MASK;
-}
-
-sub isTextFile {
- my $self = shift;
- my $bit = $self->internalFileAttributes() & IFA_TEXT_FILE_MASK;
- if (@_) {
- my $flag = shift;
- $self->{'internalFileAttributes'} &= ~IFA_TEXT_FILE_MASK;
- $self->{'internalFileAttributes'} |=
- ( $flag ? IFA_TEXT_FILE: IFA_BINARY_FILE );
- }
- return $bit == IFA_TEXT_FILE;
-}
-
-sub isBinaryFile {
- my $self = shift;
- my $bit = $self->internalFileAttributes() & IFA_TEXT_FILE_MASK;
- if (@_) {
- my $flag = shift;
- $self->{'internalFileAttributes'} &= ~IFA_TEXT_FILE_MASK;
- $self->{'internalFileAttributes'} |=
- ( $flag ? IFA_BINARY_FILE: IFA_TEXT_FILE );
- }
- return $bit == IFA_BINARY_FILE;
-}
-
-sub extractToFileNamed {
- my $self = shift;
- my $name = shift; # local FS name
- return _error("encryption unsupported") if $self->isEncrypted();
- mkpath( dirname($name) ); # croaks on error
- my ( $status, $fh ) = _newFileHandle( $name, 'w' );
- return _ioError("Can't open file $name for write") unless $status;
- my $retval = $self->extractToFileHandle($fh);
- $fh->close();
- utime( $self->lastModTime(), $self->lastModTime(), $name );
- return $retval;
-}
-
-sub isDirectory {
- return 0;
-}
-
-sub externalFileName {
- return undef;
-}
-
-# The following are used when copying data
-sub _writeOffset {
- shift->{'writeOffset'};
-}
-
-sub _readOffset {
- shift->{'readOffset'};
-}
-
-sub writeLocalHeaderRelativeOffset {
- shift->{'writeLocalHeaderRelativeOffset'};
-}
-
-sub wasWritten { shift->{'wasWritten'} }
-
-sub _dataEnded {
- shift->{'dataEnded'};
-}
-
-sub _readDataRemaining {
- shift->{'readDataRemaining'};
-}
-
-sub _inflater {
- shift->{'inflater'};
-}
-
-sub _deflater {
- shift->{'deflater'};
-}
-
-# Return the total size of my local header
-sub _localHeaderSize {
- my $self = shift;
- return SIGNATURE_LENGTH + LOCAL_FILE_HEADER_LENGTH +
- length( $self->fileName() ) + length( $self->localExtraField() );
-}
-
-# Return the total size of my CD header
-sub _centralDirectoryHeaderSize {
- my $self = shift;
- return SIGNATURE_LENGTH + CENTRAL_DIRECTORY_FILE_HEADER_LENGTH +
- length( $self->fileName() ) + length( $self->cdExtraField() ) +
- length( $self->fileComment() );
-}
-
-# DOS date/time format
-# 0-4 (5) Second divided by 2
-# 5-10 (6) Minute (0-59)
-# 11-15 (5) Hour (0-23 on a 24-hour clock)
-# 16-20 (5) Day of the month (1-31)
-# 21-24 (4) Month (1 = January, 2 = February, etc.)
-# 25-31 (7) Year offset from 1980 (add 1980 to get actual year)
-
-# Convert DOS date/time format to unix time_t format
-# NOT AN OBJECT METHOD!
-sub _dosToUnixTime {
- my $dt = shift;
- return time() unless defined($dt);
-
- my $year = ( ( $dt >> 25 ) & 0x7f ) + 80;
- my $mon = ( ( $dt >> 21 ) & 0x0f ) - 1;
- my $mday = ( ( $dt >> 16 ) & 0x1f );
-
- my $hour = ( ( $dt >> 11 ) & 0x1f );
- my $min = ( ( $dt >> 5 ) & 0x3f );
- my $sec = ( ( $dt << 1 ) & 0x3e );
-
- # catch errors
- my $time_t =
- eval { Time::Local::timelocal( $sec, $min, $hour, $mday, $mon, $year ); };
- return time() if ($@);
- return $time_t;
-}
-
-# Note, this isn't exactly UTC 1980, it's 1980 + 12 hours and 1
-# minute so that nothing timezoney can muck us up.
-my $safe_epoch = 315576060;
-
-# convert a unix time to DOS date/time
-# NOT AN OBJECT METHOD!
-sub _unixToDosTime {
- my $time_t = shift;
- unless ($time_t) {
- _error("Tried to add member with zero or undef value for time");
- $time_t = $safe_epoch;
- }
- if ( $time_t < $safe_epoch ) {
- _ioError("Unsupported date before 1980 encountered, moving to 1980");
- $time_t = $safe_epoch;
- }
- my ( $sec, $min, $hour, $mday, $mon, $year ) = localtime($time_t);
- my $dt = 0;
- $dt += ( $sec >> 1 );
- $dt += ( $min << 5 );
- $dt += ( $hour << 11 );
- $dt += ( $mday << 16 );
- $dt += ( ( $mon + 1 ) << 21 );
- $dt += ( ( $year - 80 ) << 25 );
- return $dt;
-}
-
-# Write my local header to a file handle.
-# Stores the offset to the start of the header in my
-# writeLocalHeaderRelativeOffset member.
-# Returns AZ_OK on success.
-sub _writeLocalFileHeader {
- my $self = shift;
- my $fh = shift;
-
- my $signatureData = pack( SIGNATURE_FORMAT, LOCAL_FILE_HEADER_SIGNATURE );
- $fh->print($signatureData)
- or return _ioError("writing local header signature");
-
- my $header = pack(
- LOCAL_FILE_HEADER_FORMAT,
- $self->versionNeededToExtract(),
- $self->bitFlag(),
- $self->desiredCompressionMethod(),
- $self->lastModFileDateTime(),
- $self->crc32(),
- $self->compressedSize(), # may need to be re-written later
- $self->uncompressedSize(),
- length( $self->fileName() ),
- length( $self->localExtraField() )
- );
-
- $fh->print($header) or return _ioError("writing local header");
- if ( $self->fileName() ) {
- $fh->print( $self->fileName() )
- or return _ioError("writing local header filename");
- }
- if ( $self->localExtraField() ) {
- $fh->print( $self->localExtraField() )
- or return _ioError("writing local extra field");
- }
-
- return AZ_OK;
-}
-
-sub _writeCentralDirectoryFileHeader {
- my $self = shift;
- my $fh = shift;
-
- my $sigData =
- pack( SIGNATURE_FORMAT, CENTRAL_DIRECTORY_FILE_HEADER_SIGNATURE );
- $fh->print($sigData)
- or return _ioError("writing central directory header signature");
-
- my $fileNameLength = length( $self->fileName() );
- my $extraFieldLength = length( $self->cdExtraField() );
- my $fileCommentLength = length( $self->fileComment() );
-
- my $header = pack(
- CENTRAL_DIRECTORY_FILE_HEADER_FORMAT,
- $self->versionMadeBy(),
- $self->fileAttributeFormat(),
- $self->versionNeededToExtract(),
- $self->bitFlag(),
- $self->desiredCompressionMethod(),
- $self->lastModFileDateTime(),
- $self->crc32(), # these three fields should have been updated
- $self->_writeOffset(), # by writing the data stream out
- $self->uncompressedSize(), #
- $fileNameLength,
- $extraFieldLength,
- $fileCommentLength,
- 0, # {'diskNumberStart'},
- $self->internalFileAttributes(),
- $self->externalFileAttributes(),
- $self->writeLocalHeaderRelativeOffset()
- );
-
- $fh->print($header)
- or return _ioError("writing central directory header");
- if ($fileNameLength) {
- $fh->print( $self->fileName() )
- or return _ioError("writing central directory header signature");
- }
- if ($extraFieldLength) {
- $fh->print( $self->cdExtraField() )
- or return _ioError("writing central directory extra field");
- }
- if ($fileCommentLength) {
- $fh->print( $self->fileComment() )
- or return _ioError("writing central directory file comment");
- }
-
- return AZ_OK;
-}
-
-# This writes a data descriptor to the given file handle.
-# Assumes that crc32, writeOffset, and uncompressedSize are
-# set correctly (they should be after a write).
-# Further, the local file header should have the
-# GPBF_HAS_DATA_DESCRIPTOR_MASK bit set.
-sub _writeDataDescriptor {
- my $self = shift;
- my $fh = shift;
- my $header = pack(
- SIGNATURE_FORMAT . DATA_DESCRIPTOR_FORMAT,
- DATA_DESCRIPTOR_SIGNATURE,
- $self->crc32(),
- $self->_writeOffset(), # compressed size
- $self->uncompressedSize()
- );
-
- $fh->print($header)
- or return _ioError("writing data descriptor");
- return AZ_OK;
-}
-
-# Re-writes the local file header with new crc32 and compressedSize fields.
-# To be called after writing the data stream.
-# Assumes that filename and extraField sizes didn't change since last written.
-sub _refreshLocalFileHeader {
- my $self = shift;
- my $fh = shift;
-
- my $here = $fh->tell();
- $fh->seek( $self->writeLocalHeaderRelativeOffset() + SIGNATURE_LENGTH,
- IO::Seekable::SEEK_SET )
- or return _ioError("seeking to rewrite local header");
-
- my $header = pack(
- LOCAL_FILE_HEADER_FORMAT,
- $self->versionNeededToExtract(),
- $self->bitFlag(),
- $self->desiredCompressionMethod(),
- $self->lastModFileDateTime(),
- $self->crc32(),
- $self->_writeOffset(), # compressed size
- $self->uncompressedSize(),
- length( $self->fileName() ),
- length( $self->localExtraField() )
- );
-
- $fh->print($header)
- or return _ioError("re-writing local header");
- $fh->seek( $here, IO::Seekable::SEEK_SET )
- or return _ioError("seeking after rewrite of local header");
-
- return AZ_OK;
-}
-
-sub readChunk {
- my ( $self, $chunkSize ) = @_;
-
- if ( $self->readIsDone() ) {
- $self->endRead();
- my $dummy = '';
- return ( \$dummy, AZ_STREAM_END );
- }
-
- $chunkSize = $Archive::Zip::ChunkSize if not defined($chunkSize);
- $chunkSize = $self->_readDataRemaining()
- if $chunkSize > $self->_readDataRemaining();
-
- my $buffer = '';
- my $outputRef;
- my ( $bytesRead, $status ) = $self->_readRawChunk( \$buffer, $chunkSize );
- return ( \$buffer, $status ) unless $status == AZ_OK;
-
- $self->{'readDataRemaining'} -= $bytesRead;
- $self->{'readOffset'} += $bytesRead;
-
- if ( $self->compressionMethod() == COMPRESSION_STORED ) {
- $self->{'crc32'} = $self->computeCRC32( $buffer, $self->{'crc32'} );
- }
-
- ( $outputRef, $status ) = &{ $self->{'chunkHandler'} }( $self, \$buffer );
- $self->{'writeOffset'} += length($$outputRef);
-
- $self->endRead()
- if $self->readIsDone();
-
- return ( $outputRef, $status );
-}
-
-# Read the next raw chunk of my data. Subclasses MUST implement.
-# my ( $bytesRead, $status) = $self->_readRawChunk( \$buffer, $chunkSize );
-sub _readRawChunk {
- my $self = shift;
- return $self->_subclassResponsibility();
-}
-
-# A place holder to catch rewindData errors if someone ignores
-# the error code.
-sub _noChunk {
- my $self = shift;
- return ( \undef, _error("trying to copy chunk when init failed") );
-}
-
-# Basically a no-op so that I can have a consistent interface.
-# ( $outputRef, $status) = $self->_copyChunk( \$buffer );
-sub _copyChunk {
- my ( $self, $dataRef ) = @_;
- return ( $dataRef, AZ_OK );
-}
-
-# ( $outputRef, $status) = $self->_deflateChunk( \$buffer );
-sub _deflateChunk {
- my ( $self, $buffer ) = @_;
- my ( $out, $status ) = $self->_deflater()->deflate($buffer);
-
- if ( $self->_readDataRemaining() == 0 ) {
- my $extraOutput;
- ( $extraOutput, $status ) = $self->_deflater()->flush();
- $out .= $extraOutput;
- $self->endRead();
- return ( \$out, AZ_STREAM_END );
- }
- elsif ( $status == Z_OK ) {
- return ( \$out, AZ_OK );
- }
- else {
- $self->endRead();
- my $retval = _error( 'deflate error', $status );
- my $dummy = '';
- return ( \$dummy, $retval );
- }
-}
-
-# ( $outputRef, $status) = $self->_inflateChunk( \$buffer );
-sub _inflateChunk {
- my ( $self, $buffer ) = @_;
- my ( $out, $status ) = $self->_inflater()->inflate($buffer);
- my $retval;
- $self->endRead() unless $status == Z_OK;
- if ( $status == Z_OK || $status == Z_STREAM_END ) {
- $retval = ( $status == Z_STREAM_END ) ? AZ_STREAM_END: AZ_OK;
- return ( \$out, $retval );
- }
- else {
- $retval = _error( 'inflate error', $status );
- my $dummy = '';
- return ( \$dummy, $retval );
- }
-}
-
-sub rewindData {
- my $self = shift;
- my $status;
-
- # set to trap init errors
- $self->{'chunkHandler'} = $self->can('_noChunk');
-
- # Work around WinZip bug with 0-length DEFLATED files
- $self->desiredCompressionMethod(COMPRESSION_STORED)
- if $self->uncompressedSize() == 0;
-
- # assume that we're going to read the whole file, and compute the CRC anew.
- $self->{'crc32'} = 0
- if ( $self->compressionMethod() == COMPRESSION_STORED );
-
- # These are the only combinations of methods we deal with right now.
- if ( $self->compressionMethod() == COMPRESSION_STORED
- and $self->desiredCompressionMethod() == COMPRESSION_DEFLATED )
- {
- ( $self->{'deflater'}, $status ) = Compress::Zlib::deflateInit(
- '-Level' => $self->desiredCompressionLevel(),
- '-WindowBits' => -MAX_WBITS(), # necessary magic
- '-Bufsize' => $Archive::Zip::ChunkSize,
- @_
- ); # pass additional options
- return _error( 'deflateInit error:', $status )
- unless $status == Z_OK;
- $self->{'chunkHandler'} = $self->can('_deflateChunk');
- }
- elsif ( $self->compressionMethod() == COMPRESSION_DEFLATED
- and $self->desiredCompressionMethod() == COMPRESSION_STORED )
- {
- ( $self->{'inflater'}, $status ) = Compress::Zlib::inflateInit(
- '-WindowBits' => -MAX_WBITS(), # necessary magic
- '-Bufsize' => $Archive::Zip::ChunkSize,
- @_
- ); # pass additional options
- return _error( 'inflateInit error:', $status )
- unless $status == Z_OK;
- $self->{'chunkHandler'} = $self->can('_inflateChunk');
- }
- elsif ( $self->compressionMethod() == $self->desiredCompressionMethod() ) {
- $self->{'chunkHandler'} = $self->can('_copyChunk');
- }
- else {
- return _error(
- sprintf(
- "Unsupported compression combination: read %d, write %d",
- $self->compressionMethod(),
- $self->desiredCompressionMethod()
- )
- );
- }
-
- $self->{'readDataRemaining'} =
- ( $self->compressionMethod() == COMPRESSION_STORED )
- ? $self->uncompressedSize()
- : $self->compressedSize();
- $self->{'dataEnded'} = 0;
- $self->{'readOffset'} = 0;
-
- return AZ_OK;
-}
-
-sub endRead {
- my $self = shift;
- delete $self->{'inflater'};
- delete $self->{'deflater'};
- $self->{'dataEnded'} = 1;
- $self->{'readDataRemaining'} = 0;
- return AZ_OK;
-}
-
-sub readIsDone {
- my $self = shift;
- return ( $self->_dataEnded() or !$self->_readDataRemaining() );
-}
-
-sub contents {
- my $self = shift;
- my $newContents = shift;
-
- if ( defined($newContents) ) {
-
- # change our type and call the subclass contents method.
- $self->_become(STRINGMEMBERCLASS);
- return $self->contents( pack( 'C0a*', $newContents ) )
- ; # in case of Unicode
- }
- else {
- my $oldCompression =
- $self->desiredCompressionMethod(COMPRESSION_STORED);
- my $status = $self->rewindData(@_);
- if ( $status != AZ_OK ) {
- $self->endRead();
- return $status;
- }
- my $retval = '';
- while ( $status == AZ_OK ) {
- my $ref;
- ( $ref, $status ) = $self->readChunk( $self->_readDataRemaining() );
-
- # did we get it in one chunk?
- if ( length($$ref) == $self->uncompressedSize() ) {
- $retval = $$ref;
- }
- else { $retval .= $$ref }
- }
- $self->desiredCompressionMethod($oldCompression);
- $self->endRead();
- $status = AZ_OK if $status == AZ_STREAM_END;
- $retval = undef unless $status == AZ_OK;
- return wantarray ? ( $retval, $status ) : $retval;
- }
-}
-
-sub extractToFileHandle {
- my $self = shift;
- return _error("encryption unsupported") if $self->isEncrypted();
- my $fh = shift;
- _binmode($fh);
- my $oldCompression = $self->desiredCompressionMethod(COMPRESSION_STORED);
- my $status = $self->rewindData(@_);
- $status = $self->_writeData($fh) if $status == AZ_OK;
- $self->desiredCompressionMethod($oldCompression);
- $self->endRead();
- return $status;
-}
-
-# write local header and data stream to file handle
-sub _writeToFileHandle {
- my $self = shift;
- my $fh = shift;
- my $fhIsSeekable = shift;
- my $offset = shift;
-
- return _error("no member name given for $self")
- unless $self->fileName();
-
- $self->{'writeLocalHeaderRelativeOffset'} = $offset;
- $self->{'wasWritten'} = 0;
-
- # Determine if I need to write a data descriptor
- # I need to do this if I can't refresh the header
- # and I don't know compressed size or crc32 fields.
- my $headerFieldsUnknown = (
- ( $self->uncompressedSize() > 0 )
- and ($self->compressionMethod() == COMPRESSION_STORED
- or $self->desiredCompressionMethod() == COMPRESSION_DEFLATED )
- );
-
- my $shouldWriteDataDescriptor =
- ( $headerFieldsUnknown and not $fhIsSeekable );
-
- $self->hasDataDescriptor(1)
- if ($shouldWriteDataDescriptor);
-
- $self->{'writeOffset'} = 0;
-
- my $status = $self->rewindData();
- ( $status = $self->_writeLocalFileHeader($fh) )
- if $status == AZ_OK;
- ( $status = $self->_writeData($fh) )
- if $status == AZ_OK;
- if ( $status == AZ_OK ) {
- $self->{'wasWritten'} = 1;
- if ( $self->hasDataDescriptor() ) {
- $status = $self->_writeDataDescriptor($fh);
- }
- elsif ($headerFieldsUnknown) {
- $status = $self->_refreshLocalFileHeader($fh);
- }
- }
-
- return $status;
-}
-
-# Copy my (possibly compressed) data to given file handle.
-# Returns C<AZ_OK> on success
-sub _writeData {
- my $self = shift;
- my $writeFh = shift;
-
- return AZ_OK if ( $self->uncompressedSize() == 0 );
- my $status;
- my $chunkSize = $Archive::Zip::ChunkSize;
- while ( $self->_readDataRemaining() > 0 ) {
- my $outRef;
- ( $outRef, $status ) = $self->readChunk($chunkSize);
- return $status if ( $status != AZ_OK and $status != AZ_STREAM_END );
-
- if ( length($$outRef) > 0 ) {
- $writeFh->print($$outRef)
- or return _ioError("write error during copy");
- }
-
- last if $status == AZ_STREAM_END;
- }
- $self->{'compressedSize'} = $self->_writeOffset();
- return AZ_OK;
-}
-
-# Return true if I depend on the named file
-sub _usesFileNamed {
- return 0;
-}
-
-1;
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Archive/Zip/MemberRead.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Archive/Zip/MemberRead.pm
deleted file mode 100644
index 17212004439..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Archive/Zip/MemberRead.pm
+++ /dev/null
@@ -1,333 +0,0 @@
-package Archive::Zip::MemberRead;
-
-=head1 NAME
-
-Archive::Zip::MemberRead - A wrapper that lets you read Zip archive members as if they were files.
-
-=cut
-
-=head1 SYNOPSIS
-
- use Archive::Zip;
- use Archive::Zip::MemberRead;
- $zip = new Archive::Zip("file.zip");
- $fh = new Archive::Zip::MemberRead($zip, "subdir/abc.txt");
- while (defined($line = $fh->getline()))
- {
- print $fh->input_line_number . "#: $line\n";
- }
-
- $read = $fh->read($buffer, 32*1024);
- print "Read $read bytes as :$buffer:\n";
-
-=head1 DESCRIPTION
-
-The Archive::Zip::MemberRead module lets you read Zip archive member data
-just like you read data from files.
-
-=head1 METHODS
-
-=over 4
-
-=cut
-
-use strict;
-
-use Archive::Zip qw( :ERROR_CODES :CONSTANTS );
-
-use vars qw{$VERSION};
-
-my $nl;
-
-BEGIN {
- $VERSION = '1.23';
- $VERSION = eval $VERSION;
- # Requirement for newline conversion. Should check for e.g., DOS and OS/2 as well, but am too lazy.
- $nl = $^O eq 'MSWin32' ? "\r\n" : "\n";
-}
-
-=item Archive::Zip::Member::readFileHandle()
-
-You can get a C<Archive::Zip::MemberRead> from an archive member by
-calling C<readFileHandle()>:
-
- my $member = $zip->memberNamed('abc/def.c');
- my $fh = $member->readFileHandle();
- while (defined($line = $fh->getline()))
- {
- # ...
- }
- $fh->close();
-
-=cut
-
-sub Archive::Zip::Member::readFileHandle {
- return Archive::Zip::MemberRead->new( shift() );
-}
-
-=item Archive::Zip::MemberRead->new($zip, $fileName)
-
-=item Archive::Zip::MemberRead->new($zip, $member)
-
-=item Archive::Zip::MemberRead->new($member)
-
-Construct a new Archive::Zip::MemberRead on the specified member.
-
- my $fh = Archive::Zip::MemberRead->new($zip, 'fred.c')
-
-=cut
-
-sub new {
- my ( $class, $zip, $file ) = @_;
- my ( $self, $member );
-
- if ( $zip && $file ) # zip and filename, or zip and member
- {
- $member = ref($file) ? $file : $zip->memberNamed($file);
- }
- elsif ( $zip && !$file && ref($zip) ) # just member
- {
- $member = $zip;
- }
- else {
- die(
-'Archive::Zip::MemberRead::new needs a zip and filename, zip and member, or member'
- );
- }
-
- $self = {};
- bless( $self, $class );
- $self->set_member($member);
- return $self;
-}
-
-sub set_member {
- my ( $self, $member ) = @_;
-
- $self->{member} = $member;
- $self->set_compression(COMPRESSION_STORED);
- $self->rewind();
-}
-
-sub set_compression {
- my ( $self, $compression ) = @_;
- $self->{member}->desiredCompressionMethod($compression) if $self->{member};
-}
-
-=item setLineEnd(expr)
-
-Set the line end character to use. This is set to \n by default
-except on Windows systems where it is set to \r\n. You will
-only need to set this on systems which are not Windows or Unix
-based and require a line end diffrent from \n.
-This is a class method so call as C<Archive::Zip::MemberRead>->C<setLineEnd($nl)>
-
-=cut
-
-sub setLineEnd {
- shift;
- $nl = shift;
-}
-
-=item rewind()
-
-Rewinds an C<Archive::Zip::MemberRead> so that you can read from it again
-starting at the beginning.
-
-=cut
-
-sub rewind {
- my $self = shift;
-
- $self->_reset_vars();
- $self->{member}->rewindData() if $self->{member};
-}
-
-sub _reset_vars {
- my $self = shift;
-
- $self->{line_no} = 0;
- $self->{at_end} = 0;
-
- delete $self->{buffer};
-}
-
-=item input_record_separator(expr)
-
-If the argumnet is given, input_record_separator for this
-instance is set to it. The current setting (which may be
-the global $/) is always returned.
-
-=cut
-
-sub input_record_separator {
- my $self = shift;
- if (@_) {
- $self->{sep} = shift;
- $self->{sep_re} = _sep_as_re($self->{sep}); # Cache the RE as an optimization
- }
- return exists $self->{sep} ? $self->{sep} : $/;
-}
-
-# Return the input_record_separator in use as an RE fragment
-# Note that if we have a per-instance input_record_separator
-# we can just return the already converted value. Otherwise,
-# the conversion must be done on $/ every time since we cannot
-# know whether it has changed or not.
-sub _sep_re {
- my $self = shift;
- # Important to phrase this way: sep's value may be undef.
- return exists $self->{sep} ? $self->{sep_re} : _sep_as_re($/);
-}
-
-# Convert the input record separator into an RE and return it.
-sub _sep_as_re {
- my $sep = shift;
- if (defined $sep) {
- if ($sep eq '') {
- return "(?:$nl){2,}";
- } else {
- $sep =~ s/\n/$nl/og;
- return quotemeta $sep;
- }
- } else {
- return undef;
- }
-}
-
-=item input_line_number()
-
-Returns the current line number, but only if you're using C<getline()>.
-Using C<read()> will not update the line number.
-
-=cut
-
-sub input_line_number {
- my $self = shift;
- return $self->{line_no};
-}
-
-=item close()
-
-Closes the given file handle.
-
-=cut
-
-sub close {
- my $self = shift;
-
- $self->_reset_vars();
- $self->{member}->endRead();
-}
-
-=item buffer_size([ $size ])
-
-Gets or sets the buffer size used for reads.
-Default is the chunk size used by Archive::Zip.
-
-=cut
-
-sub buffer_size {
- my ( $self, $size ) = @_;
-
- if ( !$size ) {
- return $self->{chunkSize} || Archive::Zip::chunkSize();
- }
- else {
- $self->{chunkSize} = $size;
- }
-}
-
-=item getline()
-
-Returns the next line from the currently open member.
-Makes sense only for text files.
-A read error is considered fatal enough to die.
-Returns undef on eof. All subsequent calls would return undef,
-unless a rewind() is called.
-Note: The line returned has the input_record_separator (default: newline) removed.
-
-=cut
-
-sub getline {
- my $self = shift;
- my $size = $self->buffer_size();
- my $sep = $self->_sep_re();
-
- for (;;) {
- if ( $sep
- && defined($self->{buffer})
- && $self->{buffer} =~ s/^(.*?)$sep//s
- ) {
- $self->{line_no}++;
- return $1;
- } elsif ($self->{at_end}) {
- $self->{line_no}++ if $self->{buffer};
- return delete $self->{buffer};
- }
- my ($temp,$status) = $self->{member}->readChunk($size);
- if ($status != AZ_OK && $status != AZ_STREAM_END) {
- die "ERROR: Error reading chunk from archive - $status";
- }
- $self->{at_end} = $status == AZ_STREAM_END;
- $self->{buffer} .= $$temp;
- }
-}
-
-=item read($buffer, $num_bytes_to_read)
-
-Simulates a normal C<read()> system call.
-Returns the no. of bytes read. C<undef> on error, 0 on eof, I<e.g.>:
-
- $fh = new Archive::Zip::MemberRead($zip, "sreeji/secrets.bin");
- while (1)
- {
- $read = $fh->read($buffer, 1024);
- die "FATAL ERROR reading my secrets !\n" if (!defined($read));
- last if (!$read);
- # Do processing.
- ....
- }
-
-=cut
-
-#
-# All these $_ are required to emulate read().
-#
-sub read {
- my $self = $_[0];
- my $size = $_[2];
- my ( $temp, $status, $ret );
-
- ( $temp, $status ) = $self->{member}->readChunk($size);
- if ( $status != AZ_OK && $status != AZ_STREAM_END ) {
- $_[1] = undef;
- $ret = undef;
- }
- else {
- $_[1] = $$temp;
- $ret = length($$temp);
- }
- return $ret;
-}
-
-1;
-
-=back
-
-=head1 AUTHOR
-
-Sreeji K. Das, <sreeji_k@yahoo.com>
-See L<Archive::Zip> by Ned Konz without which this module does not make
-any sense!
-
-Minor mods by Ned Konz.
-
-=head1 COPYRIGHT
-
-Copyright 2002 Sreeji K. Das.
-
-This program is free software; you can redistribute it and/or modify it under
-the same terms as Perl itself.
-
-=cut
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Archive/Zip/MockFileHandle.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Archive/Zip/MockFileHandle.pm
deleted file mode 100644
index ff846c15511..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Archive/Zip/MockFileHandle.pm
+++ /dev/null
@@ -1,69 +0,0 @@
-package Archive::Zip::MockFileHandle;
-
-# Output file handle that calls a custom write routine
-# Ned Konz, March 2000
-# This is provided to help with writing zip files
-# when you have to process them a chunk at a time.
-
-use strict;
-
-use vars qw{$VERSION};
-
-BEGIN {
- $VERSION = '1.23';
- $VERSION = eval $VERSION;
-}
-
-sub new {
- my $class = shift || __PACKAGE__;
- $class = ref($class) || $class;
- my $self = bless(
- {
- 'position' => 0,
- 'size' => 0
- },
- $class
- );
- return $self;
-}
-
-sub eof {
- my $self = shift;
- return $self->{'position'} >= $self->{'size'};
-}
-
-# Copy given buffer to me
-sub print {
- my $self = shift;
- my $bytes = join( '', @_ );
- my $bytesWritten = $self->writeHook($bytes);
- if ( $self->{'position'} + $bytesWritten > $self->{'size'} ) {
- $self->{'size'} = $self->{'position'} + $bytesWritten;
- }
- $self->{'position'} += $bytesWritten;
- return $bytesWritten;
-}
-
-# Called on each write.
-# Override in subclasses.
-# Return number of bytes written (0 on error).
-sub writeHook {
- my $self = shift;
- my $bytes = shift;
- return length($bytes);
-}
-
-sub binmode { 1 }
-
-sub close { 1 }
-
-sub clearerr { 1 }
-
-# I'm write-only!
-sub read { 0 }
-
-sub tell { return shift->{'position'} }
-
-sub opened { 1 }
-
-1;
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Archive/Zip/NewFileMember.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Archive/Zip/NewFileMember.pm
deleted file mode 100644
index 47fc54bb819..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Archive/Zip/NewFileMember.pm
+++ /dev/null
@@ -1,79 +0,0 @@
-package Archive::Zip::NewFileMember;
-
-use strict;
-use vars qw( $VERSION @ISA );
-
-BEGIN {
- $VERSION = '1.23';
- @ISA = qw ( Archive::Zip::FileMember );
-}
-
-use Archive::Zip qw(
- :CONSTANTS
- :ERROR_CODES
- :UTILITY_METHODS
-);
-
-# Given a file name, set up for eventual writing.
-sub _newFromFileNamed {
- my $class = shift;
- my $fileName = shift; # local FS format
- my $newName = shift;
- $newName = _asZipDirName($fileName) unless defined($newName);
- return undef unless ( stat($fileName) && -r _ && !-d _ );
- my $self = $class->new(@_);
- $self->fileName($newName);
- $self->{'externalFileName'} = $fileName;
- $self->{'compressionMethod'} = COMPRESSION_STORED;
- my @stat = stat(_);
- $self->{'compressedSize'} = $self->{'uncompressedSize'} = $stat[7];
- $self->desiredCompressionMethod(
- ( $self->compressedSize() > 0 )
- ? COMPRESSION_DEFLATED
- : COMPRESSION_STORED
- );
- $self->unixFileAttributes( $stat[2] );
- $self->setLastModFileDateTimeFromUnix( $stat[9] );
- $self->isTextFile( -T _ );
- return $self;
-}
-
-sub rewindData {
- my $self = shift;
-
- my $status = $self->SUPER::rewindData(@_);
- return $status unless $status == AZ_OK;
-
- return AZ_IO_ERROR unless $self->fh();
- $self->fh()->clearerr();
- $self->fh()->seek( 0, IO::Seekable::SEEK_SET )
- or return _ioError( "rewinding", $self->externalFileName() );
- return AZ_OK;
-}
-
-# Return bytes read. Note that first parameter is a ref to a buffer.
-# my $data;
-# my ( $bytesRead, $status) = $self->readRawChunk( \$data, $chunkSize );
-sub _readRawChunk {
- my ( $self, $dataRef, $chunkSize ) = @_;
- return ( 0, AZ_OK ) unless $chunkSize;
- my $bytesRead = $self->fh()->read( $$dataRef, $chunkSize )
- or return ( 0, _ioError("reading data") );
- return ( $bytesRead, AZ_OK );
-}
-
-# If I already exist, extraction is a no-op.
-sub extractToFileNamed {
- my $self = shift;
- my $name = shift; # local FS name
- if ( File::Spec->rel2abs($name) eq
- File::Spec->rel2abs( $self->externalFileName() ) and -r $name )
- {
- return AZ_OK;
- }
- else {
- return $self->SUPER::extractToFileNamed( $name, @_ );
- }
-}
-
-1;
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Archive/Zip/StringMember.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Archive/Zip/StringMember.pm
deleted file mode 100644
index c7d4101eedd..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Archive/Zip/StringMember.pm
+++ /dev/null
@@ -1,64 +0,0 @@
-package Archive::Zip::StringMember;
-
-use strict;
-use vars qw( $VERSION @ISA );
-
-BEGIN {
- $VERSION = '1.23';
- @ISA = qw( Archive::Zip::Member );
-}
-
-use Archive::Zip qw(
- :CONSTANTS
- :ERROR_CODES
-);
-
-# Create a new string member. Default is COMPRESSION_STORED.
-# Can take a ref to a string as well.
-sub _newFromString {
- my $class = shift;
- my $string = shift;
- my $name = shift;
- my $self = $class->new(@_);
- $self->contents($string);
- $self->fileName($name) if defined($name);
-
- # Set the file date to now
- $self->setLastModFileDateTimeFromUnix( time() );
- $self->unixFileAttributes( $self->DEFAULT_FILE_PERMISSIONS );
- return $self;
-}
-
-sub _become {
- my $self = shift;
- my $newClass = shift;
- return $self if ref($self) eq $newClass;
- delete( $self->{'contents'} );
- return $self->SUPER::_become($newClass);
-}
-
-# Get or set my contents. Note that we do not call the superclass
-# version of this, because it calls us.
-sub contents {
- my $self = shift;
- my $string = shift;
- if ( defined($string) ) {
- $self->{'contents'} =
- pack( 'C0a*', ( ref($string) eq 'SCALAR' ) ? $$string : $string );
- $self->{'uncompressedSize'} = $self->{'compressedSize'} =
- length( $self->{'contents'} );
- $self->{'compressionMethod'} = COMPRESSION_STORED;
- }
- return $self->{'contents'};
-}
-
-# Return bytes read. Note that first parameter is a ref to a buffer.
-# my $data;
-# my ( $bytesRead, $status) = $self->readRawChunk( \$data, $chunkSize );
-sub _readRawChunk {
- my ( $self, $dataRef, $chunkSize ) = @_;
- $$dataRef = substr( $self->contents(), $self->_readOffset(), $chunkSize );
- return ( length($$dataRef), AZ_OK );
-}
-
-1;
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Archive/Zip/Tree.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Archive/Zip/Tree.pm
deleted file mode 100644
index 92b3dc52d27..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Archive/Zip/Tree.pm
+++ /dev/null
@@ -1,46 +0,0 @@
-use Archive::Zip;
-
-use vars qw{$VERSION};
-BEGIN {
- $VERSION = '1.23';
-}
-
-warn(
-"Archive::Zip::Tree is deprecated; its methods have been moved into Archive::Zip."
-) if $^W;
-
-1;
-
-__END__
-
-=head1 NAME
-
-Archive::Zip::Tree - (DEPRECATED) methods for adding/extracting trees using Archive::Zip
-
-=head1 SYNOPSIS
-
-=head1 DESCRIPTION
-
-This module is deprecated, because all its methods were moved into the main
-Archive::Zip module.
-
-It is included in the distribution merely to avoid breaking old code.
-
-See L<Archive::Zip>.
-
-=head1 AUTHOR
-
-Ned Konz, perl@bike-nomad.com
-
-=head1 COPYRIGHT
-
-Copyright (c) 2000-2002 Ned Konz. 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<Archive::Zip>
-
-=cut
-
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Archive/Zip/ZipFileMember.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Archive/Zip/ZipFileMember.pm
deleted file mode 100644
index d177fb006fd..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Archive/Zip/ZipFileMember.pm
+++ /dev/null
@@ -1,413 +0,0 @@
-package Archive::Zip::ZipFileMember;
-
-use strict;
-use vars qw( $VERSION @ISA );
-
-BEGIN {
- $VERSION = '1.23';
- @ISA = qw ( Archive::Zip::FileMember );
-}
-
-use Archive::Zip qw(
- :CONSTANTS
- :ERROR_CODES
- :PKZIP_CONSTANTS
- :UTILITY_METHODS
-);
-
-# Create a new Archive::Zip::ZipFileMember
-# given a filename and optional open file handle
-#
-sub _newFromZipFile {
- my $class = shift;
- my $fh = shift;
- my $externalFileName = shift;
- my $possibleEocdOffset = shift; # normally 0
-
- my $self = $class->new(
- 'crc32' => 0,
- 'diskNumberStart' => 0,
- 'localHeaderRelativeOffset' => 0,
- 'dataOffset' => 0, # localHeaderRelativeOffset + header length
- @_
- );
- $self->{'externalFileName'} = $externalFileName;
- $self->{'fh'} = $fh;
- $self->{'possibleEocdOffset'} = $possibleEocdOffset;
- return $self;
-}
-
-sub isDirectory {
- my $self = shift;
- return ( substr( $self->fileName(), -1, 1 ) eq '/'
- and $self->uncompressedSize() == 0 );
-}
-
-# Seek to the beginning of the local header, just past the signature.
-# Verify that the local header signature is in fact correct.
-# Update the localHeaderRelativeOffset if necessary by adding the possibleEocdOffset.
-# Returns status.
-
-sub _seekToLocalHeader {
- my $self = shift;
- my $where = shift; # optional
- my $previousWhere = shift; # optional
-
- $where = $self->localHeaderRelativeOffset() unless defined($where);
-
- # avoid loop on certain corrupt files (from Julian Field)
- return _formatError("corrupt zip file")
- if defined($previousWhere) && $where == $previousWhere;
-
- my $status;
- my $signature;
-
- $status = $self->fh()->seek( $where, IO::Seekable::SEEK_SET );
- return _ioError("seeking to local header") unless $status;
-
- ( $status, $signature ) =
- _readSignature( $self->fh(), $self->externalFileName(),
- LOCAL_FILE_HEADER_SIGNATURE );
- return $status if $status == AZ_IO_ERROR;
-
- # retry with EOCD offset if any was given.
- if ( $status == AZ_FORMAT_ERROR && $self->{'possibleEocdOffset'} ) {
- $status = $self->_seekToLocalHeader(
- $self->localHeaderRelativeOffset() + $self->{'possibleEocdOffset'},
- $where
- );
- if ( $status == AZ_OK ) {
- $self->{'localHeaderRelativeOffset'} +=
- $self->{'possibleEocdOffset'};
- $self->{'possibleEocdOffset'} = 0;
- }
- }
-
- return $status;
-}
-
-# Because I'm going to delete the file handle, read the local file
-# header if the file handle is seekable. If it isn't, I assume that
-# I've already read the local header.
-# Return ( $status, $self )
-
-sub _become {
- my $self = shift;
- my $newClass = shift;
- return $self if ref($self) eq $newClass;
-
- my $status = AZ_OK;
-
- if ( _isSeekable( $self->fh() ) ) {
- my $here = $self->fh()->tell();
- $status = $self->_seekToLocalHeader();
- $status = $self->_readLocalFileHeader() if $status == AZ_OK;
- $self->fh()->seek( $here, IO::Seekable::SEEK_SET );
- return $status unless $status == AZ_OK;
- }
-
- delete( $self->{'eocdCrc32'} );
- delete( $self->{'diskNumberStart'} );
- delete( $self->{'localHeaderRelativeOffset'} );
- delete( $self->{'dataOffset'} );
-
- return $self->SUPER::_become($newClass);
-}
-
-sub diskNumberStart {
- shift->{'diskNumberStart'};
-}
-
-sub localHeaderRelativeOffset {
- shift->{'localHeaderRelativeOffset'};
-}
-
-sub dataOffset {
- shift->{'dataOffset'};
-}
-
-# Skip local file header, updating only extra field stuff.
-# Assumes that fh is positioned before signature.
-sub _skipLocalFileHeader {
- my $self = shift;
- my $header;
- my $bytesRead = $self->fh()->read( $header, LOCAL_FILE_HEADER_LENGTH );
- if ( $bytesRead != LOCAL_FILE_HEADER_LENGTH ) {
- return _ioError("reading local file header");
- }
- my $fileNameLength;
- my $extraFieldLength;
- my $bitFlag;
- (
- undef, # $self->{'versionNeededToExtract'},
- $bitFlag,
- undef, # $self->{'compressionMethod'},
- undef, # $self->{'lastModFileDateTime'},
- undef, # $crc32,
- undef, # $compressedSize,
- undef, # $uncompressedSize,
- $fileNameLength,
- $extraFieldLength
- ) = unpack( LOCAL_FILE_HEADER_FORMAT, $header );
-
- if ($fileNameLength) {
- $self->fh()->seek( $fileNameLength, IO::Seekable::SEEK_CUR )
- or return _ioError("skipping local file name");
- }
-
- if ($extraFieldLength) {
- $bytesRead =
- $self->fh()->read( $self->{'localExtraField'}, $extraFieldLength );
- if ( $bytesRead != $extraFieldLength ) {
- return _ioError("reading local extra field");
- }
- }
-
- $self->{'dataOffset'} = $self->fh()->tell();
-
- if ( $bitFlag & GPBF_HAS_DATA_DESCRIPTOR_MASK ) {
-
- # Read the crc32, compressedSize, and uncompressedSize from the
- # extended data descriptor, which directly follows the compressed data.
- #
- # Skip over the compressed file data (assumes that EOCD compressedSize
- # was correct)
- $self->fh()->seek( $self->{'compressedSize'}, IO::Seekable::SEEK_CUR )
- or return _ioError("seeking to extended local header");
-
- # these values should be set correctly from before.
- my $oldCrc32 = $self->{'eocdCrc32'};
- my $oldCompressedSize = $self->{'compressedSize'};
- my $oldUncompressedSize = $self->{'uncompressedSize'};
-
- my $status = $self->_readDataDescriptor();
- return $status unless $status == AZ_OK;
-
- return _formatError(
- "CRC or size mismatch while skipping data descriptor")
- if ( $oldCrc32 != $self->{'crc32'}
- || $oldUncompressedSize != $self->{'uncompressedSize'} );
- }
-
- return AZ_OK;
-}
-
-# Read from a local file header into myself. Returns AZ_OK if successful.
-# Assumes that fh is positioned after signature.
-# Note that crc32, compressedSize, and uncompressedSize will be 0 if
-# GPBF_HAS_DATA_DESCRIPTOR_MASK is set in the bitFlag.
-
-sub _readLocalFileHeader {
- my $self = shift;
- my $header;
- my $bytesRead = $self->fh()->read( $header, LOCAL_FILE_HEADER_LENGTH );
- if ( $bytesRead != LOCAL_FILE_HEADER_LENGTH ) {
- return _ioError("reading local file header");
- }
- my $fileNameLength;
- my $crc32;
- my $compressedSize;
- my $uncompressedSize;
- my $extraFieldLength;
- (
- $self->{'versionNeededToExtract'}, $self->{'bitFlag'},
- $self->{'compressionMethod'}, $self->{'lastModFileDateTime'},
- $crc32, $compressedSize,
- $uncompressedSize, $fileNameLength,
- $extraFieldLength
- ) = unpack( LOCAL_FILE_HEADER_FORMAT, $header );
-
- if ($fileNameLength) {
- my $fileName;
- $bytesRead = $self->fh()->read( $fileName, $fileNameLength );
- if ( $bytesRead != $fileNameLength ) {
- return _ioError("reading local file name");
- }
- $self->fileName($fileName);
- }
-
- if ($extraFieldLength) {
- $bytesRead =
- $self->fh()->read( $self->{'localExtraField'}, $extraFieldLength );
- if ( $bytesRead != $extraFieldLength ) {
- return _ioError("reading local extra field");
- }
- }
-
- $self->{'dataOffset'} = $self->fh()->tell();
-
- if ( $self->hasDataDescriptor() ) {
-
- # Read the crc32, compressedSize, and uncompressedSize from the
- # extended data descriptor.
- # Skip over the compressed file data (assumes that EOCD compressedSize
- # was correct)
- $self->fh()->seek( $self->{'compressedSize'}, IO::Seekable::SEEK_CUR )
- or return _ioError("seeking to extended local header");
-
- my $status = $self->_readDataDescriptor();
- return $status unless $status == AZ_OK;
- }
- else {
- return _formatError(
- "CRC or size mismatch after reading data descriptor")
- if ( $self->{'crc32'} != $crc32
- || $self->{'uncompressedSize'} != $uncompressedSize );
- }
-
- return AZ_OK;
-}
-
-# This will read the data descriptor, which is after the end of compressed file
-# data in members that that have GPBF_HAS_DATA_DESCRIPTOR_MASK set in their
-# bitFlag.
-# The only reliable way to find these is to rely on the EOCD compressedSize.
-# Assumes that file is positioned immediately after the compressed data.
-# Returns status; sets crc32, compressedSize, and uncompressedSize.
-sub _readDataDescriptor {
- my $self = shift;
- my $signatureData;
- my $header;
- my $crc32;
- my $compressedSize;
- my $uncompressedSize;
-
- my $bytesRead = $self->fh()->read( $signatureData, SIGNATURE_LENGTH );
- return _ioError("reading header signature")
- if $bytesRead != SIGNATURE_LENGTH;
- my $signature = unpack( SIGNATURE_FORMAT, $signatureData );
-
- # unfortunately, the signature appears to be optional.
- if ( $signature == DATA_DESCRIPTOR_SIGNATURE
- && ( $signature != $self->{'crc32'} ) )
- {
- $bytesRead = $self->fh()->read( $header, DATA_DESCRIPTOR_LENGTH );
- return _ioError("reading data descriptor")
- if $bytesRead != DATA_DESCRIPTOR_LENGTH;
-
- ( $crc32, $compressedSize, $uncompressedSize ) =
- unpack( DATA_DESCRIPTOR_FORMAT, $header );
- }
- else {
- $bytesRead =
- $self->fh()->read( $header, DATA_DESCRIPTOR_LENGTH_NO_SIG );
- return _ioError("reading data descriptor")
- if $bytesRead != DATA_DESCRIPTOR_LENGTH_NO_SIG;
-
- $crc32 = $signature;
- ( $compressedSize, $uncompressedSize ) =
- unpack( DATA_DESCRIPTOR_FORMAT_NO_SIG, $header );
- }
-
- $self->{'eocdCrc32'} = $self->{'crc32'}
- unless defined( $self->{'eocdCrc32'} );
- $self->{'crc32'} = $crc32;
- $self->{'compressedSize'} = $compressedSize;
- $self->{'uncompressedSize'} = $uncompressedSize;
-
- return AZ_OK;
-}
-
-# Read a Central Directory header. Return AZ_OK on success.
-# Assumes that fh is positioned right after the signature.
-
-sub _readCentralDirectoryFileHeader {
- my $self = shift;
- my $fh = $self->fh();
- my $header = '';
- my $bytesRead = $fh->read( $header, CENTRAL_DIRECTORY_FILE_HEADER_LENGTH );
- if ( $bytesRead != CENTRAL_DIRECTORY_FILE_HEADER_LENGTH ) {
- return _ioError("reading central dir header");
- }
- my ( $fileNameLength, $extraFieldLength, $fileCommentLength );
- (
- $self->{'versionMadeBy'},
- $self->{'fileAttributeFormat'},
- $self->{'versionNeededToExtract'},
- $self->{'bitFlag'},
- $self->{'compressionMethod'},
- $self->{'lastModFileDateTime'},
- $self->{'crc32'},
- $self->{'compressedSize'},
- $self->{'uncompressedSize'},
- $fileNameLength,
- $extraFieldLength,
- $fileCommentLength,
- $self->{'diskNumberStart'},
- $self->{'internalFileAttributes'},
- $self->{'externalFileAttributes'},
- $self->{'localHeaderRelativeOffset'}
- ) = unpack( CENTRAL_DIRECTORY_FILE_HEADER_FORMAT, $header );
-
- $self->{'eocdCrc32'} = $self->{'crc32'};
-
- if ($fileNameLength) {
- $bytesRead = $fh->read( $self->{'fileName'}, $fileNameLength );
- if ( $bytesRead != $fileNameLength ) {
- _ioError("reading central dir filename");
- }
- }
- if ($extraFieldLength) {
- $bytesRead = $fh->read( $self->{'cdExtraField'}, $extraFieldLength );
- if ( $bytesRead != $extraFieldLength ) {
- return _ioError("reading central dir extra field");
- }
- }
- if ($fileCommentLength) {
- $bytesRead = $fh->read( $self->{'fileComment'}, $fileCommentLength );
- if ( $bytesRead != $fileCommentLength ) {
- return _ioError("reading central dir file comment");
- }
- }
-
- # NK 10/21/04: added to avoid problems with manipulated headers
- if ( $self->{'uncompressedSize'} != $self->{'compressedSize'}
- and $self->{'compressionMethod'} == COMPRESSION_STORED )
- {
- $self->{'uncompressedSize'} = $self->{'compressedSize'};
- }
-
- $self->desiredCompressionMethod( $self->compressionMethod() );
-
- return AZ_OK;
-}
-
-sub rewindData {
- my $self = shift;
-
- my $status = $self->SUPER::rewindData(@_);
- return $status unless $status == AZ_OK;
-
- return AZ_IO_ERROR unless $self->fh();
-
- $self->fh()->clearerr();
-
- # Seek to local file header.
- # The only reason that I'm doing this this way is that the extraField
- # length seems to be different between the CD header and the LF header.
- $status = $self->_seekToLocalHeader();
- return $status unless $status == AZ_OK;
-
- # skip local file header
- $status = $self->_skipLocalFileHeader();
- return $status unless $status == AZ_OK;
-
- # Seek to beginning of file data
- $self->fh()->seek( $self->dataOffset(), IO::Seekable::SEEK_SET )
- or return _ioError("seeking to beginning of file data");
-
- return AZ_OK;
-}
-
-# Return bytes read. Note that first parameter is a ref to a buffer.
-# my $data;
-# my ( $bytesRead, $status) = $self->readRawChunk( \$data, $chunkSize );
-sub _readRawChunk {
- my ( $self, $dataRef, $chunkSize ) = @_;
- return ( 0, AZ_OK ) unless $chunkSize;
- my $bytesRead = $self->fh()->read( $$dataRef, $chunkSize )
- or return ( 0, _ioError("reading data") );
- return ( $bytesRead, AZ_OK );
-}
-
-1;
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Bundle/LWP.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Bundle/LWP.pm
deleted file mode 100644
index 0beb2d8a2ff..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Bundle/LWP.pm
+++ /dev/null
@@ -1,43 +0,0 @@
-package Bundle::LWP;
-
-$VERSION = "5.810";
-
-1;
-
-__END__
-
-=head1 NAME
-
-Bundle::LWP - install all libwww-perl related modules
-
-=head1 SYNOPSIS
-
- perl -MCPAN -e 'install Bundle::LWP'
-
-=head1 CONTENTS
-
-MIME::Base64 - Used in authentication headers
-
-Digest::MD5 - Needed to do Digest authentication
-
-URI 1.10 - There are URIs everywhere
-
-Net::FTP 2.58 - If you want ftp://-support
-
-HTML::Tagset - Needed by HTML::Parser
-
-HTML::Parser - Need by HTML::HeadParser
-
-HTML::HeadParser - To get the correct $res->base
-
-LWP - The reason why you need the modules above
-
-=head1 DESCRIPTION
-
-This bundle defines all prereq modules for libwww-perl. Bundles have
-special meaning for the CPAN module. When you install the bundle
-module all modules mentioned in L</CONTENTS> will be installed instead.
-
-=head1 SEE ALSO
-
-L<CPAN/Bundles>
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/CPAN.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/CPAN.pm
deleted file mode 100644
index edb854190cf..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/CPAN.pm
+++ /dev/null
@@ -1,12583 +0,0 @@
-# -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*-
-use strict;
-package CPAN;
-$CPAN::VERSION = '1.9205';
-$CPAN::VERSION = eval $CPAN::VERSION if $CPAN::VERSION =~ /_/;
-
-use CPAN::HandleConfig;
-use CPAN::Version;
-use CPAN::Debug;
-use CPAN::Queue;
-use CPAN::Tarzip;
-use CPAN::DeferedCode;
-use Carp ();
-use Config ();
-use Cwd ();
-use DirHandle ();
-use Exporter ();
-use ExtUtils::MakeMaker qw(prompt); # for some unknown reason,
- # 5.005_04 does not work without
- # this
-use File::Basename ();
-use File::Copy ();
-use File::Find;
-use File::Path ();
-use File::Spec ();
-use FileHandle ();
-use Fcntl qw(:flock);
-use Safe ();
-use Sys::Hostname qw(hostname);
-use Text::ParseWords ();
-use Text::Wrap ();
-
-sub find_perl ();
-
-# we need to run chdir all over and we would get at wrong libraries
-# there
-BEGIN {
- if (File::Spec->can("rel2abs")) {
- for my $inc (@INC) {
- $inc = File::Spec->rel2abs($inc) unless ref $inc;
- }
- }
-}
-no lib ".";
-
-require Mac::BuildTools if $^O eq 'MacOS';
-$ENV{PERL5_CPAN_IS_RUNNING}=$$;
-$ENV{PERL5_CPANPLUS_IS_RUNNING}=$$; # https://rt.cpan.org/Ticket/Display.html?id=23735
-
-END { $CPAN::End++; &cleanup; }
-
-$CPAN::Signal ||= 0;
-$CPAN::Frontend ||= "CPAN::Shell";
-unless (@CPAN::Defaultsites) {
- @CPAN::Defaultsites = map {
- CPAN::URL->new(TEXT => $_, FROM => "DEF")
- }
- "http://www.perl.org/CPAN/",
- "ftp://ftp.perl.org/pub/CPAN/";
-}
-# $CPAN::iCwd (i for initial) is going to be initialized during find_perl
-$CPAN::Perl ||= CPAN::find_perl();
-$CPAN::Defaultdocs ||= "http://search.cpan.org/perldoc?";
-$CPAN::Defaultrecent ||= "http://search.cpan.org/uploads.rdf";
-$CPAN::Defaultrecent ||= "http://cpan.uwinnipeg.ca/htdocs/cpan.xml";
-
-# our globals are getting a mess
-use vars qw(
- $AUTOLOAD
- $Be_Silent
- $CONFIG_DIRTY
- $Defaultdocs
- $Echo_readline
- $Frontend
- $GOTOSHELL
- $HAS_USABLE
- $Have_warned
- $MAX_RECURSION
- $META
- $RUN_DEGRADED
- $Signal
- $SQLite
- $Suppress_readline
- $VERSION
- $autoload_recursion
- $term
- @Defaultsites
- @EXPORT
- );
-
-$MAX_RECURSION = 32;
-
-@CPAN::ISA = qw(CPAN::Debug Exporter);
-
-# note that these functions live in CPAN::Shell and get executed via
-# AUTOLOAD when called directly
-@EXPORT = qw(
- autobundle
- bundle
- clean
- cvs_import
- expand
- force
- fforce
- get
- install
- install_tested
- is_tested
- make
- mkmyconfig
- notest
- perldoc
- readme
- recent
- recompile
- report
- shell
- smoke
- test
- upgrade
- );
-
-sub soft_chdir_with_alternatives ($);
-
-{
- $autoload_recursion ||= 0;
-
- #-> sub CPAN::AUTOLOAD ;
- sub AUTOLOAD {
- $autoload_recursion++;
- my($l) = $AUTOLOAD;
- $l =~ s/.*:://;
- if ($CPAN::Signal) {
- warn "Refusing to autoload '$l' while signal pending";
- $autoload_recursion--;
- return;
- }
- if ($autoload_recursion > 1) {
- my $fullcommand = join " ", map { "'$_'" } $l, @_;
- warn "Refusing to autoload $fullcommand in recursion\n";
- $autoload_recursion--;
- return;
- }
- my(%export);
- @export{@EXPORT} = '';
- CPAN::HandleConfig->load unless $CPAN::Config_loaded++;
- if (exists $export{$l}) {
- CPAN::Shell->$l(@_);
- } else {
- die(qq{Unknown CPAN command "$AUTOLOAD". }.
- qq{Type ? for help.\n});
- }
- $autoload_recursion--;
- }
-}
-
-#-> sub CPAN::shell ;
-sub shell {
- my($self) = @_;
- $Suppress_readline = ! -t STDIN unless defined $Suppress_readline;
- CPAN::HandleConfig->load unless $CPAN::Config_loaded++;
-
- my $oprompt = shift || CPAN::Prompt->new;
- my $prompt = $oprompt;
- my $commandline = shift || "";
- $CPAN::CurrentCommandId ||= 1;
-
- local($^W) = 1;
- unless ($Suppress_readline) {
- require Term::ReadLine;
- if (! $term
- or
- $term->ReadLine eq "Term::ReadLine::Stub"
- ) {
- $term = Term::ReadLine->new('CPAN Monitor');
- }
- if ($term->ReadLine eq "Term::ReadLine::Gnu") {
- my $attribs = $term->Attribs;
- $attribs->{attempted_completion_function} = sub {
- &CPAN::Complete::gnu_cpl;
- }
- } else {
- $readline::rl_completion_function =
- $readline::rl_completion_function = 'CPAN::Complete::cpl';
- }
- if (my $histfile = $CPAN::Config->{'histfile'}) {{
- unless ($term->can("AddHistory")) {
- $CPAN::Frontend->mywarn("Terminal does not support AddHistory.\n");
- last;
- }
- $META->readhist($term,$histfile);
- }}
- for ($CPAN::Config->{term_ornaments}) { # alias
- local $Term::ReadLine::termcap_nowarn = 1;
- $term->ornaments($_) if defined;
- }
- # $term->OUT is autoflushed anyway
- my $odef = select STDERR;
- $| = 1;
- select STDOUT;
- $| = 1;
- select $odef;
- }
-
- $META->checklock();
- my @cwd = grep { defined $_ and length $_ }
- CPAN::anycwd(),
- File::Spec->can("tmpdir") ? File::Spec->tmpdir() : (),
- File::Spec->rootdir();
- my $try_detect_readline;
- $try_detect_readline = $term->ReadLine eq "Term::ReadLine::Stub" if $term;
- unless ($CPAN::Config->{inhibit_startup_message}) {
- my $rl_avail = $Suppress_readline ? "suppressed" :
- ($term->ReadLine ne "Term::ReadLine::Stub") ? "enabled" :
- "available (maybe install Bundle::CPAN or Bundle::CPANxxl?)";
- $CPAN::Frontend->myprint(
- sprintf qq{
-cpan shell -- CPAN exploration and modules installation (v%s)
-ReadLine support %s
-
-},
- $CPAN::VERSION,
- $rl_avail
- )
- }
- my($continuation) = "";
- my $last_term_ornaments;
- SHELLCOMMAND: while () {
- if ($Suppress_readline) {
- if ($Echo_readline) {
- $|=1;
- }
- print $prompt;
- last SHELLCOMMAND unless defined ($_ = <> );
- if ($Echo_readline) {
- # backdoor: I could not find a way to record sessions
- print $_;
- }
- chomp;
- } else {
- last SHELLCOMMAND unless
- defined ($_ = $term->readline($prompt, $commandline));
- }
- $_ = "$continuation$_" if $continuation;
- s/^\s+//;
- next SHELLCOMMAND if /^$/;
- s/^\s*\?\s*/help /;
- if (/^(?:q(?:uit)?|bye|exit)$/i) {
- last SHELLCOMMAND;
- } elsif (s/\\$//s) {
- chomp;
- $continuation = $_;
- $prompt = " > ";
- } elsif (/^\!/) {
- s/^\!//;
- my($eval) = $_;
- package CPAN::Eval;
- use strict;
- use vars qw($import_done);
- CPAN->import(':DEFAULT') unless $import_done++;
- CPAN->debug("eval[$eval]") if $CPAN::DEBUG;
- eval($eval);
- warn $@ if $@;
- $continuation = "";
- $prompt = $oprompt;
- } elsif (/./) {
- my(@line);
- eval { @line = Text::ParseWords::shellwords($_) };
- warn($@), next SHELLCOMMAND if $@;
- warn("Text::Parsewords could not parse the line [$_]"),
- next SHELLCOMMAND unless @line;
- $CPAN::META->debug("line[".join("|",@line)."]") if $CPAN::DEBUG;
- my $command = shift @line;
- eval { CPAN::Shell->$command(@line) };
- if ($@) {
- my $err = "$@";
- if ($err =~ /\S/) {
- require Carp;
- require Dumpvalue;
- my $dv = Dumpvalue->new();
- Carp::cluck(sprintf "Catching error: %s", $dv->stringify($err));
- }
- }
- if ($command =~ /^(
- # classic commands
- make
- |test
- |install
- |clean
-
- # pragmas for classic commands
- |ff?orce
- |notest
-
- # compounds
- |report
- |smoke
- |upgrade
- )$/x) {
- # only commands that tell us something about failed distros
- CPAN::Shell->failed($CPAN::CurrentCommandId,1);
- }
- soft_chdir_with_alternatives(\@cwd);
- $CPAN::Frontend->myprint("\n");
- $continuation = "";
- $CPAN::CurrentCommandId++;
- $prompt = $oprompt;
- }
- } continue {
- $commandline = ""; # I do want to be able to pass a default to
- # shell, but on the second command I see no
- # use in that
- $Signal=0;
- CPAN::Queue->nullify_queue;
- if ($try_detect_readline) {
- if ($CPAN::META->has_inst("Term::ReadLine::Gnu")
- ||
- $CPAN::META->has_inst("Term::ReadLine::Perl")
- ) {
- delete $INC{"Term/ReadLine.pm"};
- my $redef = 0;
- local($SIG{__WARN__}) = CPAN::Shell::paintdots_onreload(\$redef);
- require Term::ReadLine;
- $CPAN::Frontend->myprint("\n$redef subroutines in ".
- "Term::ReadLine redefined\n");
- $GOTOSHELL = 1;
- }
- }
- if ($term and $term->can("ornaments")) {
- for ($CPAN::Config->{term_ornaments}) { # alias
- if (defined $_) {
- if (not defined $last_term_ornaments
- or $_ != $last_term_ornaments
- ) {
- local $Term::ReadLine::termcap_nowarn = 1;
- $term->ornaments($_);
- $last_term_ornaments = $_;
- }
- } else {
- undef $last_term_ornaments;
- }
- }
- }
- for my $class (qw(Module Distribution)) {
- # again unsafe meta access?
- for my $dm (keys %{$CPAN::META->{readwrite}{"CPAN::$class"}}) {
- next unless $CPAN::META->{readwrite}{"CPAN::$class"}{$dm}{incommandcolor};
- CPAN->debug("BUG: $class '$dm' was in command state, resetting");
- delete $CPAN::META->{readwrite}{"CPAN::$class"}{$dm}{incommandcolor};
- }
- }
- if ($GOTOSHELL) {
- $GOTOSHELL = 0; # not too often
- $META->savehist if $CPAN::term && $CPAN::term->can("GetHistory");
- @_ = ($oprompt,"");
- goto &shell;
- }
- }
- soft_chdir_with_alternatives(\@cwd);
-}
-
-#-> CPAN::soft_chdir_with_alternatives ;
-sub soft_chdir_with_alternatives ($) {
- my($cwd) = @_;
- unless (@$cwd) {
- my $root = File::Spec->rootdir();
- $CPAN::Frontend->mywarn(qq{Warning: no good directory to chdir to!
-Trying '$root' as temporary haven.
-});
- push @$cwd, $root;
- }
- while () {
- if (chdir $cwd->[0]) {
- return;
- } else {
- if (@$cwd>1) {
- $CPAN::Frontend->mywarn(qq{Could not chdir to "$cwd->[0]": $!
-Trying to chdir to "$cwd->[1]" instead.
-});
- shift @$cwd;
- } else {
- $CPAN::Frontend->mydie(qq{Could not chdir to "$cwd->[0]": $!});
- }
- }
- }
-}
-
-sub _flock {
- my($fh,$mode) = @_;
- if ($Config::Config{d_flock}) {
- return flock $fh, $mode;
- } elsif (!$Have_warned->{"d_flock"}++) {
- $CPAN::Frontend->mywarn("Your OS does not support locking; continuing and ignoring all locking issues\n");
- $CPAN::Frontend->mysleep(5);
- return 1;
- } else {
- return 1;
- }
-}
-
-sub _yaml_module () {
- my $yaml_module = $CPAN::Config->{yaml_module} || "YAML";
- if (
- $yaml_module ne "YAML"
- &&
- !$CPAN::META->has_inst($yaml_module)
- ) {
- # $CPAN::Frontend->mywarn("'$yaml_module' not installed, falling back to 'YAML'\n");
- $yaml_module = "YAML";
- }
- if ($yaml_module eq "YAML"
- &&
- $CPAN::META->has_inst($yaml_module)
- &&
- $YAML::VERSION < 0.60
- &&
- !$Have_warned->{"YAML"}++
- ) {
- $CPAN::Frontend->mywarn("Warning: YAML version '$YAML::VERSION' is too low, please upgrade!\n".
- "I'll continue but problems are *very* likely to happen.\n"
- );
- $CPAN::Frontend->mysleep(5);
- }
- return $yaml_module;
-}
-
-# CPAN::_yaml_loadfile
-sub _yaml_loadfile {
- my($self,$local_file) = @_;
- return +[] unless -s $local_file;
- my $yaml_module = _yaml_module;
- if ($CPAN::META->has_inst($yaml_module)) {
- # temporarly enable yaml code deserialisation
- no strict 'refs';
- # 5.6.2 could not do the local() with the reference
- local $YAML::LoadCode;
- local $YAML::Syck::LoadCode;
- ${ "$yaml_module\::LoadCode" } = $CPAN::Config->{yaml_load_code} || 0;
-
- my $code;
- if ($code = UNIVERSAL::can($yaml_module, "LoadFile")) {
- my @yaml;
- eval { @yaml = $code->($local_file); };
- if ($@) {
- # this shall not be done by the frontend
- die CPAN::Exception::yaml_process_error->new($yaml_module,$local_file,"parse",$@);
- }
- return \@yaml;
- } elsif ($code = UNIVERSAL::can($yaml_module, "Load")) {
- local *FH;
- open FH, $local_file or die "Could not open '$local_file': $!";
- local $/;
- my $ystream = <FH>;
- my @yaml;
- eval { @yaml = $code->($ystream); };
- if ($@) {
- # this shall not be done by the frontend
- die CPAN::Exception::yaml_process_error->new($yaml_module,$local_file,"parse",$@);
- }
- return \@yaml;
- }
- } else {
- # this shall not be done by the frontend
- die CPAN::Exception::yaml_not_installed->new($yaml_module, $local_file, "parse");
- }
- return +[];
-}
-
-# CPAN::_yaml_dumpfile
-sub _yaml_dumpfile {
- my($self,$local_file,@what) = @_;
- my $yaml_module = _yaml_module;
- if ($CPAN::META->has_inst($yaml_module)) {
- my $code;
- if (UNIVERSAL::isa($local_file, "FileHandle")) {
- $code = UNIVERSAL::can($yaml_module, "Dump");
- eval { print $local_file $code->(@what) };
- } elsif ($code = UNIVERSAL::can($yaml_module, "DumpFile")) {
- eval { $code->($local_file,@what); };
- } elsif ($code = UNIVERSAL::can($yaml_module, "Dump")) {
- local *FH;
- open FH, ">$local_file" or die "Could not open '$local_file': $!";
- print FH $code->(@what);
- }
- if ($@) {
- die CPAN::Exception::yaml_process_error->new($yaml_module,$local_file,"dump",$@);
- }
- } else {
- if (UNIVERSAL::isa($local_file, "FileHandle")) {
- # I think this case does not justify a warning at all
- } else {
- die CPAN::Exception::yaml_not_installed->new($yaml_module, $local_file, "dump");
- }
- }
-}
-
-sub _init_sqlite () {
- unless ($CPAN::META->has_inst("CPAN::SQLite")) {
- $CPAN::Frontend->mywarn(qq{CPAN::SQLite not installed, trying to work without\n})
- unless $Have_warned->{"CPAN::SQLite"}++;
- return;
- }
- require CPAN::SQLite::META; # not needed since CVS version of 2006-12-17
- $CPAN::SQLite ||= CPAN::SQLite::META->new($CPAN::META);
-}
-
-{
- my $negative_cache = {};
- sub _sqlite_running {
- if ($negative_cache->{time} && time < $negative_cache->{time} + 60) {
- # need to cache the result, otherwise too slow
- return $negative_cache->{fact};
- } else {
- $negative_cache = {}; # reset
- }
- my $ret = $CPAN::Config->{use_sqlite} && ($CPAN::SQLite || _init_sqlite());
- return $ret if $ret; # fast anyway
- $negative_cache->{time} = time;
- return $negative_cache->{fact} = $ret;
- }
-}
-
-package CPAN::CacheMgr;
-use strict;
-@CPAN::CacheMgr::ISA = qw(CPAN::InfoObj CPAN);
-use File::Find;
-
-package CPAN::FTP;
-use strict;
-use Fcntl qw(:flock);
-use vars qw($connect_to_internet_ok $Ua $Thesite $ThesiteURL $Themethod);
-@CPAN::FTP::ISA = qw(CPAN::Debug);
-
-package CPAN::LWP::UserAgent;
-use strict;
-use vars qw(@ISA $USER $PASSWD $SETUPDONE);
-# we delay requiring LWP::UserAgent and setting up inheritance until we need it
-
-package CPAN::Complete;
-use strict;
-@CPAN::Complete::ISA = qw(CPAN::Debug);
-# Q: where is the "How do I add a new command" HOWTO?
-# A: svn diff -r 1048:1049 where andk added the report command
-@CPAN::Complete::COMMANDS = sort qw(
- ? ! a b d h i m o q r u
- autobundle
- bye
- clean
- cvs_import
- dump
- exit
- failed
- force
- fforce
- hosts
- install
- install_tested
- is_tested
- look
- ls
- make
- mkmyconfig
- notest
- perldoc
- quit
- readme
- recent
- recompile
- reload
- report
- reports
- scripts
- smoke
- test
- upgrade
-);
-
-package CPAN::Index;
-use strict;
-use vars qw($LAST_TIME $DATE_OF_02 $DATE_OF_03 $HAVE_REANIMATED);
-@CPAN::Index::ISA = qw(CPAN::Debug);
-$LAST_TIME ||= 0;
-$DATE_OF_03 ||= 0;
-# use constant PROTOCOL => "2.0"; # outcommented to avoid warning on upgrade from 1.57
-sub PROTOCOL { 2.0 }
-
-package CPAN::InfoObj;
-use strict;
-@CPAN::InfoObj::ISA = qw(CPAN::Debug);
-
-package CPAN::Author;
-use strict;
-@CPAN::Author::ISA = qw(CPAN::InfoObj);
-
-package CPAN::Distribution;
-use strict;
-@CPAN::Distribution::ISA = qw(CPAN::InfoObj);
-
-package CPAN::Bundle;
-use strict;
-@CPAN::Bundle::ISA = qw(CPAN::Module);
-
-package CPAN::Module;
-use strict;
-@CPAN::Module::ISA = qw(CPAN::InfoObj);
-
-package CPAN::Exception::RecursiveDependency;
-use strict;
-use overload '""' => "as_string";
-
-# a module sees its distribution (no version)
-# a distribution sees its prereqs (which are module names) (usually with versions)
-# a bundle sees its module names and/or its distributions (no version)
-
-sub new {
- my($class) = shift;
- my($deps) = shift;
- my (@deps,%seen,$loop_starts_with);
- DCHAIN: for my $dep (@$deps) {
- push @deps, {name => $dep, display_as => $dep};
- if ($seen{$dep}++) {
- $loop_starts_with = $dep;
- last DCHAIN;
- }
- }
- my $in_loop = 0;
- for my $i (0..$#deps) {
- my $x = $deps[$i]{name};
- $in_loop ||= $x eq $loop_starts_with;
- my $xo = CPAN::Shell->expandany($x) or next;
- if ($xo->isa("CPAN::Module")) {
- my $have = $xo->inst_version || "N/A";
- my($want,$d,$want_type);
- if ($i>0 and $d = $deps[$i-1]{name}) {
- my $do = CPAN::Shell->expandany($d);
- $want = $do->{prereq_pm}{requires}{$x};
- if (defined $want) {
- $want_type = "requires: ";
- } else {
- $want = $do->{prereq_pm}{build_requires}{$x};
- if (defined $want) {
- $want_type = "build_requires: ";
- } else {
- $want_type = "unknown status";
- $want = "???";
- }
- }
- } else {
- $want = $xo->cpan_version;
- $want_type = "want: ";
- }
- $deps[$i]{have} = $have;
- $deps[$i]{want_type} = $want_type;
- $deps[$i]{want} = $want;
- $deps[$i]{display_as} = "$x (have: $have; $want_type$want)";
- } elsif ($xo->isa("CPAN::Distribution")) {
- $deps[$i]{display_as} = $xo->pretty_id;
- if ($in_loop) {
- $xo->{make} = CPAN::Distrostatus->new("NO cannot resolve circular dependency");
- } else {
- $xo->{make} = CPAN::Distrostatus->new("NO one dependency ($loop_starts_with) is a circular dependency");
- }
- $xo->store_persistent_state; # otherwise I will not reach
- # all involved parties for
- # the next session
- }
- }
- bless { deps => \@deps }, $class;
-}
-
-sub as_string {
- my($self) = shift;
- my $ret = "\nRecursive dependency detected:\n ";
- $ret .= join("\n => ", map {$_->{display_as}} @{$self->{deps}});
- $ret .= ".\nCannot resolve.\n";
- $ret;
-}
-
-package CPAN::Exception::yaml_not_installed;
-use strict;
-use overload '""' => "as_string";
-
-sub new {
- my($class,$module,$file,$during) = @_;
- bless { module => $module, file => $file, during => $during }, $class;
-}
-
-sub as_string {
- my($self) = shift;
- "'$self->{module}' not installed, cannot $self->{during} '$self->{file}'\n";
-}
-
-package CPAN::Exception::yaml_process_error;
-use strict;
-use overload '""' => "as_string";
-
-sub new {
- my($class,$module,$file,$during,$error) = @_;
- bless { module => $module,
- file => $file,
- during => $during,
- error => $error }, $class;
-}
-
-sub as_string {
- my($self) = shift;
- if ($self->{during}) {
- if ($self->{file}) {
- if ($self->{module}) {
- if ($self->{error}) {
- return "Alert: While trying to '$self->{during}' YAML file\n".
- " '$self->{file}'\n".
- "with '$self->{module}' the following error was encountered:\n".
- " $self->{error}\n";
- } else {
- return "Alert: While trying to '$self->{during}' YAML file\n".
- " '$self->{file}'\n".
- "with '$self->{module}' some unknown error was encountered\n";
- }
- } else {
- return "Alert: While trying to '$self->{during}' YAML file\n".
- " '$self->{file}'\n".
- "some unknown error was encountered\n";
- }
- } else {
- return "Alert: While trying to '$self->{during}' some YAML file\n".
- "some unknown error was encountered\n";
- }
- } else {
- return "Alert: unknown error encountered\n";
- }
-}
-
-package CPAN::Prompt; use overload '""' => "as_string";
-use vars qw($prompt);
-$prompt = "cpan> ";
-$CPAN::CurrentCommandId ||= 0;
-sub new {
- bless {}, shift;
-}
-sub as_string {
- my $word = "cpan";
- unless ($CPAN::META->{LOCK}) {
- $word = "nolock_cpan";
- }
- if ($CPAN::Config->{commandnumber_in_prompt}) {
- sprintf "$word\[%d]> ", $CPAN::CurrentCommandId;
- } else {
- "$word> ";
- }
-}
-
-package CPAN::URL; use overload '""' => "as_string", fallback => 1;
-# accessors: TEXT(the url string), FROM(DEF=>defaultlist,USER=>urllist),
-# planned are things like age or quality
-sub new {
- my($class,%args) = @_;
- bless {
- %args
- }, $class;
-}
-sub as_string {
- my($self) = @_;
- $self->text;
-}
-sub text {
- my($self,$set) = @_;
- if (defined $set) {
- $self->{TEXT} = $set;
- }
- $self->{TEXT};
-}
-
-package CPAN::Distrostatus;
-use overload '""' => "as_string",
- fallback => 1;
-sub new {
- my($class,$arg) = @_;
- bless {
- TEXT => $arg,
- FAILED => substr($arg,0,2) eq "NO",
- COMMANDID => $CPAN::CurrentCommandId,
- TIME => time,
- }, $class;
-}
-sub commandid { shift->{COMMANDID} }
-sub failed { shift->{FAILED} }
-sub text {
- my($self,$set) = @_;
- if (defined $set) {
- $self->{TEXT} = $set;
- }
- $self->{TEXT};
-}
-sub as_string {
- my($self) = @_;
- $self->text;
-}
-
-package CPAN::Shell;
-use strict;
-use vars qw(
- $ADVANCED_QUERY
- $AUTOLOAD
- $COLOR_REGISTERED
- $Help
- $autoload_recursion
- $reload
- @ISA
- );
-@CPAN::Shell::ISA = qw(CPAN::Debug);
-$COLOR_REGISTERED ||= 0;
-$Help = {
- '?' => \"help",
- '!' => "eval the rest of the line as perl",
- a => "whois author",
- autobundle => "wtite inventory into a bundle file",
- b => "info about bundle",
- bye => \"quit",
- clean => "clean up a distribution's build directory",
- # cvs_import
- d => "info about a distribution",
- # dump
- exit => \"quit",
- failed => "list all failed actions within current session",
- fforce => "redo a command from scratch",
- force => "redo a command",
- h => \"help",
- help => "overview over commands; 'help ...' explains specific commands",
- hosts => "statistics about recently used hosts",
- i => "info about authors/bundles/distributions/modules",
- install => "install a distribution",
- install_tested => "install all distributions tested OK",
- is_tested => "list all distributions tested OK",
- look => "open a subshell in a distribution's directory",
- ls => "list distributions according to a glob",
- m => "info about a module",
- make => "make/build a distribution",
- mkmyconfig => "write current config into a CPAN/MyConfig.pm file",
- notest => "run a (usually install) command but leave out the test phase",
- o => "'o conf ...' for config stuff; 'o debug ...' for debugging",
- perldoc => "try to get a manpage for a module",
- q => \"quit",
- quit => "leave the cpan shell",
- r => "review over upgradeable modules",
- readme => "display the README of a distro woth a pager",
- recent => "show recent uploads to the CPAN",
- # recompile
- reload => "'reload cpan' or 'reload index'",
- report => "test a distribution and send a test report to cpantesters",
- reports => "info about reported tests from cpantesters",
- # scripts
- # smoke
- test => "test a distribution",
- u => "display uninstalled modules",
- upgrade => "combine 'r' command with immediate installation",
- };
-{
- $autoload_recursion ||= 0;
-
- #-> sub CPAN::Shell::AUTOLOAD ;
- sub AUTOLOAD {
- $autoload_recursion++;
- my($l) = $AUTOLOAD;
- my $class = shift(@_);
- # warn "autoload[$l] class[$class]";
- $l =~ s/.*:://;
- if ($CPAN::Signal) {
- warn "Refusing to autoload '$l' while signal pending";
- $autoload_recursion--;
- return;
- }
- if ($autoload_recursion > 1) {
- my $fullcommand = join " ", map { "'$_'" } $l, @_;
- warn "Refusing to autoload $fullcommand in recursion\n";
- $autoload_recursion--;
- return;
- }
- if ($l =~ /^w/) {
- # XXX needs to be reconsidered
- if ($CPAN::META->has_inst('CPAN::WAIT')) {
- CPAN::WAIT->$l(@_);
- } else {
- $CPAN::Frontend->mywarn(qq{
-Commands starting with "w" require CPAN::WAIT to be installed.
-Please consider installing CPAN::WAIT to use the fulltext index.
-For this you just need to type
- install CPAN::WAIT
-});
- }
- } else {
- $CPAN::Frontend->mywarn(qq{Unknown shell command '$l'. }.
- qq{Type ? for help.
-});
- }
- $autoload_recursion--;
- }
-}
-
-package CPAN;
-use strict;
-
-$META ||= CPAN->new; # In case we re-eval ourselves we need the ||
-
-# from here on only subs.
-################################################################################
-
-sub _perl_fingerprint {
- my($self,$other_fingerprint) = @_;
- my $dll = eval {OS2::DLLname()};
- my $mtime_dll = 0;
- if (defined $dll) {
- $mtime_dll = (-f $dll ? (stat(_))[9] : '-1');
- }
- my $mtime_perl = (-f CPAN::find_perl ? (stat(_))[9] : '-1');
- my $this_fingerprint = {
- '$^X' => CPAN::find_perl,
- sitearchexp => $Config::Config{sitearchexp},
- 'mtime_$^X' => $mtime_perl,
- 'mtime_dll' => $mtime_dll,
- };
- if ($other_fingerprint) {
- if (exists $other_fingerprint->{'stat($^X)'}) { # repair fp from rev. 1.88_57
- $other_fingerprint->{'mtime_$^X'} = $other_fingerprint->{'stat($^X)'}[9];
- }
- # mandatory keys since 1.88_57
- for my $key (qw($^X sitearchexp mtime_dll mtime_$^X)) {
- return unless $other_fingerprint->{$key} eq $this_fingerprint->{$key};
- }
- return 1;
- } else {
- return $this_fingerprint;
- }
-}
-
-sub suggest_myconfig () {
- SUGGEST_MYCONFIG: if(!$INC{'CPAN/MyConfig.pm'}) {
- $CPAN::Frontend->myprint("You don't seem to have a user ".
- "configuration (MyConfig.pm) yet.\n");
- my $new = CPAN::Shell::colorable_makemaker_prompt("Do you want to create a ".
- "user configuration now? (Y/n)",
- "yes");
- if($new =~ m{^y}i) {
- CPAN::Shell->mkmyconfig();
- return &checklock;
- } else {
- $CPAN::Frontend->mydie("OK, giving up.");
- }
- }
-}
-
-#-> sub CPAN::all_objects ;
-sub all_objects {
- my($mgr,$class) = @_;
- CPAN::HandleConfig->load unless $CPAN::Config_loaded++;
- CPAN->debug("mgr[$mgr] class[$class]") if $CPAN::DEBUG;
- CPAN::Index->reload;
- values %{ $META->{readwrite}{$class} }; # unsafe meta access, ok
-}
-
-# Called by shell, not in batch mode. In batch mode I see no risk in
-# having many processes updating something as installations are
-# continually checked at runtime. In shell mode I suspect it is
-# unintentional to open more than one shell at a time
-
-#-> sub CPAN::checklock ;
-sub checklock {
- my($self) = @_;
- my $lockfile = File::Spec->catfile($CPAN::Config->{cpan_home},".lock");
- if (-f $lockfile && -M _ > 0) {
- my $fh = FileHandle->new($lockfile) or
- $CPAN::Frontend->mydie("Could not open lockfile '$lockfile': $!");
- my $otherpid = <$fh>;
- my $otherhost = <$fh>;
- $fh->close;
- if (defined $otherpid && $otherpid) {
- chomp $otherpid;
- }
- if (defined $otherhost && $otherhost) {
- chomp $otherhost;
- }
- my $thishost = hostname();
- if (defined $otherhost && defined $thishost &&
- $otherhost ne '' && $thishost ne '' &&
- $otherhost ne $thishost) {
- $CPAN::Frontend->mydie(sprintf("CPAN.pm panic: Lockfile '$lockfile'\n".
- "reports other host $otherhost and other ".
- "process $otherpid.\n".
- "Cannot proceed.\n"));
- } elsif ($RUN_DEGRADED) {
- $CPAN::Frontend->mywarn("Running in degraded mode (experimental)\n");
- } elsif (defined $otherpid && $otherpid) {
- return if $$ == $otherpid; # should never happen
- $CPAN::Frontend->mywarn(
- qq{
-There seems to be running another CPAN process (pid $otherpid). Contacting...
-});
- if (kill 0, $otherpid) {
- $CPAN::Frontend->mywarn(qq{Other job is running.\n});
- my($ans) =
- CPAN::Shell::colorable_makemaker_prompt
- (qq{Shall I try to run in degraded }.
- qq{mode? (Y/n)},"y");
- if ($ans =~ /^y/i) {
- $CPAN::Frontend->mywarn("Running in degraded mode (experimental).
-Please report if something unexpected happens\n");
- $RUN_DEGRADED = 1;
- for ($CPAN::Config) {
- # XXX
- # $_->{build_dir_reuse} = 0; # 2006-11-17 akoenig Why was that?
- $_->{commandnumber_in_prompt} = 0; # visibility
- $_->{histfile} = ""; # who should win otherwise?
- $_->{cache_metadata} = 0; # better would be a lock?
- $_->{use_sqlite} = 0; # better would be a write lock!
- }
- } else {
- $CPAN::Frontend->mydie("
-You may want to kill the other job and delete the lockfile. On UNIX try:
- kill $otherpid
- rm $lockfile
-");
- }
- } elsif (-w $lockfile) {
- my($ans) =
- CPAN::Shell::colorable_makemaker_prompt
- (qq{Other job not responding. Shall I overwrite }.
- qq{the lockfile '$lockfile'? (Y/n)},"y");
- $CPAN::Frontend->myexit("Ok, bye\n")
- unless $ans =~ /^y/i;
- } else {
- Carp::croak(
- qq{Lockfile '$lockfile' not writeable by you. }.
- qq{Cannot proceed.\n}.
- qq{ On UNIX try:\n}.
- qq{ rm '$lockfile'\n}.
- qq{ and then rerun us.\n}
- );
- }
- } else {
- $CPAN::Frontend->mydie(sprintf("CPAN.pm panic: Found invalid lockfile ".
- "'$lockfile', please remove. Cannot proceed.\n"));
- }
- }
- my $dotcpan = $CPAN::Config->{cpan_home};
- eval { File::Path::mkpath($dotcpan);};
- if ($@) {
- # A special case at least for Jarkko.
- my $firsterror = $@;
- my $seconderror;
- my $symlinkcpan;
- if (-l $dotcpan) {
- $symlinkcpan = readlink $dotcpan;
- die "readlink $dotcpan failed: $!" unless defined $symlinkcpan;
- eval { File::Path::mkpath($symlinkcpan); };
- if ($@) {
- $seconderror = $@;
- } else {
- $CPAN::Frontend->mywarn(qq{
-Working directory $symlinkcpan created.
-});
- }
- }
- unless (-d $dotcpan) {
- my $mess = qq{
-Your configuration suggests "$dotcpan" as your
-CPAN.pm working directory. I could not create this directory due
-to this error: $firsterror\n};
- $mess .= qq{
-As "$dotcpan" is a symlink to "$symlinkcpan",
-I tried to create that, but I failed with this error: $seconderror
-} if $seconderror;
- $mess .= qq{
-Please make sure the directory exists and is writable.
-};
- $CPAN::Frontend->mywarn($mess);
- return suggest_myconfig;
- }
- } # $@ after eval mkpath $dotcpan
- if (0) { # to test what happens when a race condition occurs
- for (reverse 1..10) {
- print $_, "\n";
- sleep 1;
- }
- }
- # locking
- if (!$RUN_DEGRADED && !$self->{LOCKFH}) {
- my $fh;
- unless ($fh = FileHandle->new("+>>$lockfile")) {
- if ($! =~ /Permission/) {
- $CPAN::Frontend->mywarn(qq{
-
-Your configuration suggests that CPAN.pm should use a working
-directory of
- $CPAN::Config->{cpan_home}
-Unfortunately we could not create the lock file
- $lockfile
-due to permission problems.
-
-Please make sure that the configuration variable
- \$CPAN::Config->{cpan_home}
-points to a directory where you can write a .lock file. You can set
-this variable in either a CPAN/MyConfig.pm or a CPAN/Config.pm in your
-\@INC path;
-});
- return suggest_myconfig;
- }
- }
- my $sleep = 1;
- while (!CPAN::_flock($fh, LOCK_EX|LOCK_NB)) {
- if ($sleep>10) {
- $CPAN::Frontend->mydie("Giving up\n");
- }
- $CPAN::Frontend->mysleep($sleep++);
- $CPAN::Frontend->mywarn("Could not lock lockfile with flock: $!; retrying\n");
- }
-
- seek $fh, 0, 0;
- truncate $fh, 0;
- $fh->autoflush(1);
- $fh->print($$, "\n");
- $fh->print(hostname(), "\n");
- $self->{LOCK} = $lockfile;
- $self->{LOCKFH} = $fh;
- }
- $SIG{TERM} = sub {
- my $sig = shift;
- &cleanup;
- $CPAN::Frontend->mydie("Got SIG$sig, leaving");
- };
- $SIG{INT} = sub {
- # no blocks!!!
- my $sig = shift;
- &cleanup if $Signal;
- die "Got yet another signal" if $Signal > 1;
- $CPAN::Frontend->mydie("Got another SIG$sig") if $Signal;
- $CPAN::Frontend->mywarn("Caught SIG$sig, trying to continue\n");
- $Signal++;
- };
-
-# From: Larry Wall <larry@wall.org>
-# Subject: Re: deprecating SIGDIE
-# To: perl5-porters@perl.org
-# Date: Thu, 30 Sep 1999 14:58:40 -0700 (PDT)
-#
-# The original intent of __DIE__ was only to allow you to substitute one
-# kind of death for another on an application-wide basis without respect
-# to whether you were in an eval or not. As a global backstop, it should
-# not be used any more lightly (or any more heavily :-) than class
-# UNIVERSAL. Any attempt to build a general exception model on it should
-# be politely squashed. Any bug that causes every eval {} to have to be
-# modified should be not so politely squashed.
-#
-# Those are my current opinions. It is also my optinion that polite
-# arguments degenerate to personal arguments far too frequently, and that
-# when they do, it's because both people wanted it to, or at least didn't
-# sufficiently want it not to.
-#
-# Larry
-
- # global backstop to cleanup if we should really die
- $SIG{__DIE__} = \&cleanup;
- $self->debug("Signal handler set.") if $CPAN::DEBUG;
-}
-
-#-> sub CPAN::DESTROY ;
-sub DESTROY {
- &cleanup; # need an eval?
-}
-
-#-> sub CPAN::anycwd ;
-sub anycwd () {
- my $getcwd;
- $getcwd = $CPAN::Config->{'getcwd'} || 'cwd';
- CPAN->$getcwd();
-}
-
-#-> sub CPAN::cwd ;
-sub cwd {Cwd::cwd();}
-
-#-> sub CPAN::getcwd ;
-sub getcwd {Cwd::getcwd();}
-
-#-> sub CPAN::fastcwd ;
-sub fastcwd {Cwd::fastcwd();}
-
-#-> sub CPAN::backtickcwd ;
-sub backtickcwd {my $cwd = `cwd`; chomp $cwd; $cwd}
-
-#-> sub CPAN::find_perl ;
-sub find_perl () {
- my($perl) = File::Spec->file_name_is_absolute($^X) ? $^X : "";
- my $pwd = $CPAN::iCwd = CPAN::anycwd();
- my $candidate = File::Spec->catfile($pwd,$^X);
- $perl ||= $candidate if MM->maybe_command($candidate);
-
- unless ($perl) {
- my ($component,$perl_name);
- DIST_PERLNAME: foreach $perl_name ($^X, 'perl', 'perl5', "perl$]") {
- PATH_COMPONENT: foreach $component (File::Spec->path(),
- $Config::Config{'binexp'}) {
- next unless defined($component) && $component;
- my($abs) = File::Spec->catfile($component,$perl_name);
- if (MM->maybe_command($abs)) {
- $perl = $abs;
- last DIST_PERLNAME;
- }
- }
- }
- }
-
- return $perl;
-}
-
-
-#-> sub CPAN::exists ;
-sub exists {
- my($mgr,$class,$id) = @_;
- CPAN::HandleConfig->load unless $CPAN::Config_loaded++;
- CPAN::Index->reload;
- ### Carp::croak "exists called without class argument" unless $class;
- $id ||= "";
- $id =~ s/:+/::/g if $class eq "CPAN::Module";
- my $exists;
- if (CPAN::_sqlite_running) {
- $exists = (exists $META->{readonly}{$class}{$id} or
- $CPAN::SQLite->set($class, $id));
- } else {
- $exists = exists $META->{readonly}{$class}{$id};
- }
- $exists ||= exists $META->{readwrite}{$class}{$id}; # unsafe meta access, ok
-}
-
-#-> sub CPAN::delete ;
-sub delete {
- my($mgr,$class,$id) = @_;
- delete $META->{readonly}{$class}{$id}; # unsafe meta access, ok
- delete $META->{readwrite}{$class}{$id}; # unsafe meta access, ok
-}
-
-#-> sub CPAN::has_usable
-# has_inst is sometimes too optimistic, we should replace it with this
-# has_usable whenever a case is given
-sub has_usable {
- my($self,$mod,$message) = @_;
- return 1 if $HAS_USABLE->{$mod};
- my $has_inst = $self->has_inst($mod,$message);
- return unless $has_inst;
- my $usable;
- $usable = {
- LWP => [ # we frequently had "Can't locate object
- # method "new" via package "LWP::UserAgent" at
- # (eval 69) line 2006
- sub {require LWP},
- sub {require LWP::UserAgent},
- sub {require HTTP::Request},
- sub {require URI::URL},
- ],
- 'Net::FTP' => [
- sub {require Net::FTP},
- sub {require Net::Config},
- ],
- 'File::HomeDir' => [
- sub {require File::HomeDir;
- unless (CPAN::Version->vge(File::HomeDir::->VERSION, 0.52)) {
- for ("Will not use File::HomeDir, need 0.52\n") {
- $CPAN::Frontend->mywarn($_);
- die $_;
- }
- }
- },
- ],
- 'Archive::Tar' => [
- sub {require Archive::Tar;
- unless (CPAN::Version->vge(Archive::Tar::->VERSION, 1.00)) {
- for ("Will not use Archive::Tar, need 1.00\n") {
- $CPAN::Frontend->mywarn($_);
- die $_;
- }
- }
- },
- ],
- 'File::Temp' => [
- # XXX we should probably delete from
- # %INC too so we can load after we
- # installed a new enough version --
- # I'm not sure.
- sub {require File::Temp;
- unless (CPAN::Version->vge(File::Temp::->VERSION,0.16)) {
- for ("Will not use File::Temp, need 0.16\n") {
- $CPAN::Frontend->mywarn($_);
- die $_;
- }
- }
- },
- ]
- };
- if ($usable->{$mod}) {
- for my $c (0..$#{$usable->{$mod}}) {
- my $code = $usable->{$mod}[$c];
- my $ret = eval { &$code() };
- $ret = "" unless defined $ret;
- if ($@) {
- # warn "DEBUG: c[$c]\$\@[$@]ret[$ret]";
- return;
- }
- }
- }
- return $HAS_USABLE->{$mod} = 1;
-}
-
-#-> sub CPAN::has_inst
-sub has_inst {
- my($self,$mod,$message) = @_;
- Carp::croak("CPAN->has_inst() called without an argument")
- unless defined $mod;
- my %dont = map { $_ => 1 } keys %{$CPAN::META->{dontload_hash}||{}},
- keys %{$CPAN::Config->{dontload_hash}||{}},
- @{$CPAN::Config->{dontload_list}||[]};
- if (defined $message && $message eq "no" # afair only used by Nox
- ||
- $dont{$mod}
- ) {
- $CPAN::META->{dontload_hash}{$mod}||=1; # unsafe meta access, ok
- return 0;
- }
- my $file = $mod;
- my $obj;
- $file =~ s|::|/|g;
- $file .= ".pm";
- if ($INC{$file}) {
- # checking %INC is wrong, because $INC{LWP} may be true
- # although $INC{"URI/URL.pm"} may have failed. But as
- # I really want to say "bla loaded OK", I have to somehow
- # cache results.
- ### warn "$file in %INC"; #debug
- return 1;
- } elsif (eval { require $file }) {
- # eval is good: if we haven't yet read the database it's
- # perfect and if we have installed the module in the meantime,
- # it tries again. The second require is only a NOOP returning
- # 1 if we had success, otherwise it's retrying
-
- my $mtime = (stat $INC{$file})[9];
- # privileged files loaded by has_inst; Note: we use $mtime
- # as a proxy for a checksum.
- $CPAN::Shell::reload->{$file} = $mtime;
- my $v = eval "\$$mod\::VERSION";
- $v = $v ? " (v$v)" : "";
- CPAN::Shell->optprint("load_module","CPAN: $mod loaded ok$v\n");
- if ($mod eq "CPAN::WAIT") {
- push @CPAN::Shell::ISA, 'CPAN::WAIT';
- }
- return 1;
- } elsif ($mod eq "Net::FTP") {
- $CPAN::Frontend->mywarn(qq{
- Please, install Net::FTP as soon as possible. CPAN.pm installs it for you
- if you just type
- install Bundle::libnet
-
-}) unless $Have_warned->{"Net::FTP"}++;
- $CPAN::Frontend->mysleep(3);
- } elsif ($mod eq "Digest::SHA") {
- if ($Have_warned->{"Digest::SHA"}++) {
- $CPAN::Frontend->mywarn(qq{CPAN: checksum security checks disabled }.
- qq{because Digest::SHA not installed.\n});
- } else {
- $CPAN::Frontend->mywarn(qq{
- CPAN: checksum security checks disabled because Digest::SHA not installed.
- Please consider installing the Digest::SHA module.
-
-});
- $CPAN::Frontend->mysleep(2);
- }
- } elsif ($mod eq "Module::Signature") {
- # NOT prefs_lookup, we are not a distro
- my $check_sigs = $CPAN::Config->{check_sigs};
- if (not $check_sigs) {
- # they do not want us:-(
- } elsif (not $Have_warned->{"Module::Signature"}++) {
- # No point in complaining unless the user can
- # reasonably install and use it.
- if (eval { require Crypt::OpenPGP; 1 } ||
- (
- defined $CPAN::Config->{'gpg'}
- &&
- $CPAN::Config->{'gpg'} =~ /\S/
- )
- ) {
- $CPAN::Frontend->mywarn(qq{
- CPAN: Module::Signature security checks disabled because Module::Signature
- not installed. Please consider installing the Module::Signature module.
- You may also need to be able to connect over the Internet to the public
- keyservers like pgp.mit.edu (port 11371).
-
-});
- $CPAN::Frontend->mysleep(2);
- }
- }
- } else {
- delete $INC{$file}; # if it inc'd LWP but failed during, say, URI
- }
- return 0;
-}
-
-#-> sub CPAN::instance ;
-sub instance {
- my($mgr,$class,$id) = @_;
- CPAN::Index->reload;
- $id ||= "";
- # unsafe meta access, ok?
- return $META->{readwrite}{$class}{$id} if exists $META->{readwrite}{$class}{$id};
- $META->{readwrite}{$class}{$id} ||= $class->new(ID => $id);
-}
-
-#-> sub CPAN::new ;
-sub new {
- bless {}, shift;
-}
-
-#-> sub CPAN::cleanup ;
-sub cleanup {
- # warn "cleanup called with arg[@_] End[$CPAN::End] Signal[$Signal]";
- local $SIG{__DIE__} = '';
- my($message) = @_;
- my $i = 0;
- my $ineval = 0;
- my($subroutine);
- while ((undef,undef,undef,$subroutine) = caller(++$i)) {
- $ineval = 1, last if
- $subroutine eq '(eval)';
- }
- return if $ineval && !$CPAN::End;
- return unless defined $META->{LOCK};
- return unless -f $META->{LOCK};
- $META->savehist;
- close $META->{LOCKFH};
- unlink $META->{LOCK};
- # require Carp;
- # Carp::cluck("DEBUGGING");
- if ( $CPAN::CONFIG_DIRTY ) {
- $CPAN::Frontend->mywarn("Warning: Configuration not saved.\n");
- }
- $CPAN::Frontend->myprint("Lockfile removed.\n");
-}
-
-#-> sub CPAN::readhist
-sub readhist {
- my($self,$term,$histfile) = @_;
- my($fh) = FileHandle->new;
- open $fh, "<$histfile" or last;
- local $/ = "\n";
- while (<$fh>) {
- chomp;
- $term->AddHistory($_);
- }
- close $fh;
-}
-
-#-> sub CPAN::savehist
-sub savehist {
- my($self) = @_;
- my($histfile,$histsize);
- unless ($histfile = $CPAN::Config->{'histfile'}) {
- $CPAN::Frontend->mywarn("No history written (no histfile specified).\n");
- return;
- }
- $histsize = $CPAN::Config->{'histsize'} || 100;
- if ($CPAN::term) {
- unless ($CPAN::term->can("GetHistory")) {
- $CPAN::Frontend->mywarn("Terminal does not support GetHistory.\n");
- return;
- }
- } else {
- return;
- }
- my @h = $CPAN::term->GetHistory;
- splice @h, 0, @h-$histsize if @h>$histsize;
- my($fh) = FileHandle->new;
- open $fh, ">$histfile" or $CPAN::Frontend->mydie("Couldn't open >$histfile: $!");
- local $\ = local $, = "\n";
- print $fh @h;
- close $fh;
-}
-
-#-> sub CPAN::is_tested
-sub is_tested {
- my($self,$what,$when) = @_;
- unless ($what) {
- Carp::cluck("DEBUG: empty what");
- return;
- }
- $self->{is_tested}{$what} = $when;
-}
-
-#-> sub CPAN::is_installed
-# unsets the is_tested flag: as soon as the thing is installed, it is
-# not needed in set_perl5lib anymore
-sub is_installed {
- my($self,$what) = @_;
- delete $self->{is_tested}{$what};
-}
-
-sub _list_sorted_descending_is_tested {
- my($self) = @_;
- sort
- { ($self->{is_tested}{$b}||0) <=> ($self->{is_tested}{$a}||0) }
- keys %{$self->{is_tested}}
-}
-
-#-> sub CPAN::set_perl5lib
-sub set_perl5lib {
- my($self,$for) = @_;
- unless ($for) {
- (undef,undef,undef,$for) = caller(1);
- $for =~ s/.*://;
- }
- $self->{is_tested} ||= {};
- return unless %{$self->{is_tested}};
- my $env = $ENV{PERL5LIB};
- $env = $ENV{PERLLIB} unless defined $env;
- my @env;
- push @env, $env if defined $env and length $env;
- #my @dirs = map {("$_/blib/arch", "$_/blib/lib")} keys %{$self->{is_tested}};
- #$CPAN::Frontend->myprint("Prepending @dirs to PERL5LIB.\n");
-
- my @dirs = map {("$_/blib/arch", "$_/blib/lib")} $self->_list_sorted_descending_is_tested;
- if (@dirs < 12) {
- $CPAN::Frontend->myprint("Prepending @dirs to PERL5LIB for '$for'\n");
- } elsif (@dirs < 24) {
- my @d = map {my $cp = $_;
- $cp =~ s/^\Q$CPAN::Config->{build_dir}\E/%BUILDDIR%/;
- $cp
- } @dirs;
- $CPAN::Frontend->myprint("Prepending @d to PERL5LIB; ".
- "%BUILDDIR%=$CPAN::Config->{build_dir} ".
- "for '$for'\n"
- );
- } else {
- my $cnt = keys %{$self->{is_tested}};
- $CPAN::Frontend->myprint("Prepending blib/arch and blib/lib of ".
- "$cnt build dirs to PERL5LIB; ".
- "for '$for'\n"
- );
- }
-
- $ENV{PERL5LIB} = join $Config::Config{path_sep}, @dirs, @env;
-}
-
-package CPAN::CacheMgr;
-use strict;
-
-#-> sub CPAN::CacheMgr::as_string ;
-sub as_string {
- eval { require Data::Dumper };
- if ($@) {
- return shift->SUPER::as_string;
- } else {
- return Data::Dumper::Dumper(shift);
- }
-}
-
-#-> sub CPAN::CacheMgr::cachesize ;
-sub cachesize {
- shift->{DU};
-}
-
-#-> sub CPAN::CacheMgr::tidyup ;
-sub tidyup {
- my($self) = @_;
- return unless $CPAN::META->{LOCK};
- return unless -d $self->{ID};
- my @toremove = grep { $self->{SIZE}{$_}==0 } @{$self->{FIFO}};
- for my $current (0..$#toremove) {
- my $toremove = $toremove[$current];
- $CPAN::Frontend->myprint(sprintf(
- "DEL(%d/%d): %s \n",
- $current+1,
- scalar @toremove,
- $toremove,
- )
- );
- return if $CPAN::Signal;
- $self->_clean_cache($toremove);
- return if $CPAN::Signal;
- }
-}
-
-#-> sub CPAN::CacheMgr::dir ;
-sub dir {
- shift->{ID};
-}
-
-#-> sub CPAN::CacheMgr::entries ;
-sub entries {
- my($self,$dir) = @_;
- return unless defined $dir;
- $self->debug("reading dir[$dir]") if $CPAN::DEBUG;
- $dir ||= $self->{ID};
- my($cwd) = CPAN::anycwd();
- chdir $dir or Carp::croak("Can't chdir to $dir: $!");
- my $dh = DirHandle->new(File::Spec->curdir)
- or Carp::croak("Couldn't opendir $dir: $!");
- my(@entries);
- for ($dh->read) {
- next if $_ eq "." || $_ eq "..";
- if (-f $_) {
- push @entries, File::Spec->catfile($dir,$_);
- } elsif (-d _) {
- push @entries, File::Spec->catdir($dir,$_);
- } else {
- $CPAN::Frontend->mywarn("Warning: weird direntry in $dir: $_\n");
- }
- }
- chdir $cwd or Carp::croak("Can't chdir to $cwd: $!");
- sort { -M $a <=> -M $b} @entries;
-}
-
-#-> sub CPAN::CacheMgr::disk_usage ;
-sub disk_usage {
- my($self,$dir,$fast) = @_;
- return if exists $self->{SIZE}{$dir};
- return if $CPAN::Signal;
- my($Du) = 0;
- if (-e $dir) {
- if (-d $dir) {
- unless (-x $dir) {
- unless (chmod 0755, $dir) {
- $CPAN::Frontend->mywarn("I have neither the -x permission nor the ".
- "permission to change the permission; cannot ".
- "estimate disk usage of '$dir'\n");
- $CPAN::Frontend->mysleep(5);
- return;
- }
- }
- } elsif (-f $dir) {
- # nothing to say, no matter what the permissions
- }
- } else {
- $CPAN::Frontend->mywarn("File or directory '$dir' has gone, ignoring\n");
- return;
- }
- if ($fast) {
- $Du = 0; # placeholder
- } else {
- find(
- sub {
- $File::Find::prune++ if $CPAN::Signal;
- return if -l $_;
- if ($^O eq 'MacOS') {
- require Mac::Files;
- my $cat = Mac::Files::FSpGetCatInfo($_);
- $Du += $cat->ioFlLgLen() + $cat->ioFlRLgLen() if $cat;
- } else {
- if (-d _) {
- unless (-x _) {
- unless (chmod 0755, $_) {
- $CPAN::Frontend->mywarn("I have neither the -x permission nor ".
- "the permission to change the permission; ".
- "can only partially estimate disk usage ".
- "of '$_'\n");
- $CPAN::Frontend->mysleep(5);
- return;
- }
- }
- } else {
- $Du += (-s _);
- }
- }
- },
- $dir
- );
- }
- return if $CPAN::Signal;
- $self->{SIZE}{$dir} = $Du/1024/1024;
- unshift @{$self->{FIFO}}, $dir;
- $self->debug("measured $dir is $Du") if $CPAN::DEBUG;
- $self->{DU} += $Du/1024/1024;
- $self->{DU};
-}
-
-#-> sub CPAN::CacheMgr::_clean_cache ;
-sub _clean_cache {
- my($self,$dir) = @_;
- return unless -e $dir;
- unless (File::Spec->canonpath(File::Basename::dirname($dir))
- eq File::Spec->canonpath($CPAN::Config->{build_dir})) {
- $CPAN::Frontend->mywarn("Directory '$dir' not below $CPAN::Config->{build_dir}, ".
- "will not remove\n");
- $CPAN::Frontend->mysleep(5);
- return;
- }
- $self->debug("have to rmtree $dir, will free $self->{SIZE}{$dir}")
- if $CPAN::DEBUG;
- File::Path::rmtree($dir);
- my $id_deleted = 0;
- if ($dir !~ /\.yml$/ && -f "$dir.yml") {
- my $yaml_module = CPAN::_yaml_module;
- if ($CPAN::META->has_inst($yaml_module)) {
- my($peek_yaml) = eval { CPAN->_yaml_loadfile("$dir.yml"); };
- if ($@) {
- $CPAN::Frontend->mywarn("(parse error on '$dir.yml' removing anyway)");
- unlink "$dir.yml" or
- $CPAN::Frontend->mywarn("(Could not unlink '$dir.yml': $!)");
- return;
- } elsif (my $id = $peek_yaml->[0]{distribution}{ID}) {
- $CPAN::META->delete("CPAN::Distribution", $id);
-
- # XXX we should restore the state NOW, otherise this
- # distro does not exist until we read an index. BUG ALERT(?)
-
- # $CPAN::Frontend->mywarn (" +++\n");
- $id_deleted++;
- }
- }
- unlink "$dir.yml"; # may fail
- unless ($id_deleted) {
- CPAN->debug("no distro found associated with '$dir'");
- }
- }
- $self->{DU} -= $self->{SIZE}{$dir};
- delete $self->{SIZE}{$dir};
-}
-
-#-> sub CPAN::CacheMgr::new ;
-sub new {
- my $class = shift;
- my $time = time;
- my($debug,$t2);
- $debug = "";
- my $self = {
- ID => $CPAN::Config->{build_dir},
- MAX => $CPAN::Config->{'build_cache'},
- SCAN => $CPAN::Config->{'scan_cache'} || 'atstart',
- DU => 0
- };
- File::Path::mkpath($self->{ID});
- my $dh = DirHandle->new($self->{ID});
- bless $self, $class;
- $self->scan_cache;
- $t2 = time;
- $debug .= "timing of CacheMgr->new: ".($t2 - $time);
- $time = $t2;
- CPAN->debug($debug) if $CPAN::DEBUG;
- $self;
-}
-
-#-> sub CPAN::CacheMgr::scan_cache ;
-sub scan_cache {
- my $self = shift;
- return if $self->{SCAN} eq 'never';
- $CPAN::Frontend->mydie("Unknown scan_cache argument: $self->{SCAN}")
- unless $self->{SCAN} eq 'atstart';
- return unless $CPAN::META->{LOCK};
- $CPAN::Frontend->myprint(
- sprintf("Scanning cache %s for sizes\n",
- $self->{ID}));
- my $e;
- my @entries = $self->entries($self->{ID});
- my $i = 0;
- my $painted = 0;
- for $e (@entries) {
- my $symbol = ".";
- if ($self->{DU} > $self->{MAX}) {
- $symbol = "-";
- $self->disk_usage($e,1);
- } else {
- $self->disk_usage($e);
- }
- $i++;
- while (($painted/76) < ($i/@entries)) {
- $CPAN::Frontend->myprint($symbol);
- $painted++;
- }
- return if $CPAN::Signal;
- }
- $CPAN::Frontend->myprint("DONE\n");
- $self->tidyup;
-}
-
-package CPAN::Shell;
-use strict;
-
-#-> sub CPAN::Shell::h ;
-sub h {
- my($class,$about) = @_;
- if (defined $about) {
- my $help;
- if (exists $Help->{$about}) {
- if (ref $Help->{$about}) { # aliases
- $about = ${$Help->{$about}};
- }
- $help = $Help->{$about};
- } else {
- $help = "No help available";
- }
- $CPAN::Frontend->myprint("$about\: $help\n");
- } else {
- my $filler = " " x (80 - 28 - length($CPAN::VERSION));
- $CPAN::Frontend->myprint(qq{
-Display Information $filler (ver $CPAN::VERSION)
- command argument description
- a,b,d,m WORD or /REGEXP/ about authors, bundles, distributions, modules
- i WORD or /REGEXP/ about any of the above
- ls AUTHOR or GLOB about files in the author's directory
- (with WORD being a module, bundle or author name or a distribution
- name of the form AUTHOR/DISTRIBUTION)
-
-Download, Test, Make, Install...
- get download clean make clean
- make make (implies get) look open subshell in dist directory
- test make test (implies make) readme display these README files
- install make install (implies test) perldoc display POD documentation
-
-Upgrade
- r WORDs or /REGEXP/ or NONE report updates for some/matching/all modules
- upgrade WORDs or /REGEXP/ or NONE upgrade some/matching/all modules
-
-Pragmas
- force CMD try hard to do command fforce CMD try harder
- notest CMD skip testing
-
-Other
- h,? display this menu ! perl-code eval a perl command
- o conf [opt] set and query options q quit the cpan shell
- reload cpan load CPAN.pm again reload index load newer indices
- autobundle Snapshot recent latest CPAN uploads});
-}
-}
-
-*help = \&h;
-
-#-> sub CPAN::Shell::a ;
-sub a {
- my($self,@arg) = @_;
- # authors are always UPPERCASE
- for (@arg) {
- $_ = uc $_ unless /=/;
- }
- $CPAN::Frontend->myprint($self->format_result('Author',@arg));
-}
-
-#-> sub CPAN::Shell::globls ;
-sub globls {
- my($self,$s,$pragmas) = @_;
- # ls is really very different, but we had it once as an ordinary
- # command in the Shell (upto rev. 321) and we could not handle
- # force well then
- my(@accept,@preexpand);
- if ($s =~ /[\*\?\/]/) {
- if ($CPAN::META->has_inst("Text::Glob")) {
- if (my($au,$pathglob) = $s =~ m|(.*?)/(.*)|) {
- my $rau = Text::Glob::glob_to_regex(uc $au);
- CPAN::Shell->debug("au[$au]pathglob[$pathglob]rau[$rau]")
- if $CPAN::DEBUG;
- push @preexpand, map { $_->id . "/" . $pathglob }
- CPAN::Shell->expand_by_method('CPAN::Author',['id'],"/$rau/");
- } else {
- my $rau = Text::Glob::glob_to_regex(uc $s);
- push @preexpand, map { $_->id }
- CPAN::Shell->expand_by_method('CPAN::Author',
- ['id'],
- "/$rau/");
- }
- } else {
- $CPAN::Frontend->mydie("Text::Glob not installed, cannot proceed");
- }
- } else {
- push @preexpand, uc $s;
- }
- for (@preexpand) {
- unless (/^[A-Z0-9\-]+(\/|$)/i) {
- $CPAN::Frontend->mywarn("ls command rejects argument $_: not an author\n");
- next;
- }
- push @accept, $_;
- }
- my $silent = @accept>1;
- my $last_alpha = "";
- my @results;
- for my $a (@accept) {
- my($author,$pathglob);
- if ($a =~ m|(.*?)/(.*)|) {
- my $a2 = $1;
- $pathglob = $2;
- $author = CPAN::Shell->expand_by_method('CPAN::Author',
- ['id'],
- $a2)
- or $CPAN::Frontend->mydie("No author found for $a2\n");
- } else {
- $author = CPAN::Shell->expand_by_method('CPAN::Author',
- ['id'],
- $a)
- or $CPAN::Frontend->mydie("No author found for $a\n");
- }
- if ($silent) {
- my $alpha = substr $author->id, 0, 1;
- my $ad;
- if ($alpha eq $last_alpha) {
- $ad = "";
- } else {
- $ad = "[$alpha]";
- $last_alpha = $alpha;
- }
- $CPAN::Frontend->myprint($ad);
- }
- for my $pragma (@$pragmas) {
- if ($author->can($pragma)) {
- $author->$pragma();
- }
- }
- push @results, $author->ls($pathglob,$silent); # silent if
- # more than one
- # author
- for my $pragma (@$pragmas) {
- my $unpragma = "un$pragma";
- if ($author->can($unpragma)) {
- $author->$unpragma();
- }
- }
- }
- @results;
-}
-
-#-> sub CPAN::Shell::local_bundles ;
-sub local_bundles {
- my($self,@which) = @_;
- my($incdir,$bdir,$dh);
- foreach $incdir ($CPAN::Config->{'cpan_home'},@INC) {
- my @bbase = "Bundle";
- while (my $bbase = shift @bbase) {
- $bdir = File::Spec->catdir($incdir,split /::/, $bbase);
- CPAN->debug("bdir[$bdir]\@bbase[@bbase]") if $CPAN::DEBUG;
- if ($dh = DirHandle->new($bdir)) { # may fail
- my($entry);
- for $entry ($dh->read) {
- next if $entry =~ /^\./;
- next unless $entry =~ /^\w+(\.pm)?(?!\n)\Z/;
- if (-d File::Spec->catdir($bdir,$entry)) {
- push @bbase, "$bbase\::$entry";
- } else {
- next unless $entry =~ s/\.pm(?!\n)\Z//;
- $CPAN::META->instance('CPAN::Bundle',"$bbase\::$entry");
- }
- }
- }
- }
- }
-}
-
-#-> sub CPAN::Shell::b ;
-sub b {
- my($self,@which) = @_;
- CPAN->debug("which[@which]") if $CPAN::DEBUG;
- $self->local_bundles;
- $CPAN::Frontend->myprint($self->format_result('Bundle',@which));
-}
-
-#-> sub CPAN::Shell::d ;
-sub d { $CPAN::Frontend->myprint(shift->format_result('Distribution',@_));}
-
-#-> sub CPAN::Shell::m ;
-sub m { # emacs confused here }; sub mimimimimi { # emacs in sync here
- my $self = shift;
- $CPAN::Frontend->myprint($self->format_result('Module',@_));
-}
-
-#-> sub CPAN::Shell::i ;
-sub i {
- my($self) = shift;
- my(@args) = @_;
- @args = '/./' unless @args;
- my(@result);
- for my $type (qw/Bundle Distribution Module/) {
- push @result, $self->expand($type,@args);
- }
- # Authors are always uppercase.
- push @result, $self->expand("Author", map { uc $_ } @args);
-
- my $result = @result == 1 ?
- $result[0]->as_string :
- @result == 0 ?
- "No objects found of any type for argument @args\n" :
- join("",
- (map {$_->as_glimpse} @result),
- scalar @result, " items found\n",
- );
- $CPAN::Frontend->myprint($result);
-}
-
-#-> sub CPAN::Shell::o ;
-
-# CPAN::Shell::o and CPAN::HandleConfig::edit are closely related. 'o
-# conf' calls through to CPAN::HandleConfig::edit. 'o conf' should
-# probably have been called 'set' and 'o debug' maybe 'set debug' or
-# 'debug'; 'o conf ARGS' calls ->edit in CPAN/HandleConfig.pm
-sub o {
- my($self,$o_type,@o_what) = @_;
- $o_type ||= "";
- CPAN->debug("o_type[$o_type] o_what[".join(" | ",@o_what)."]\n");
- if ($o_type eq 'conf') {
- my($cfilter);
- ($cfilter) = $o_what[0] =~ m|^/(.*)/$| if @o_what;
- if (!@o_what or $cfilter) { # print all things, "o conf"
- $cfilter ||= "";
- my $qrfilter = eval 'qr/$cfilter/';
- my($k,$v);
- $CPAN::Frontend->myprint("\$CPAN::Config options from ");
- my @from;
- if (exists $INC{'CPAN/Config.pm'}) {
- push @from, $INC{'CPAN/Config.pm'};
- }
- if (exists $INC{'CPAN/MyConfig.pm'}) {
- push @from, $INC{'CPAN/MyConfig.pm'};
- }
- $CPAN::Frontend->myprint(join " and ", map {"'$_'"} @from);
- $CPAN::Frontend->myprint(":\n");
- for $k (sort keys %CPAN::HandleConfig::can) {
- next unless $k =~ /$qrfilter/;
- $v = $CPAN::HandleConfig::can{$k};
- $CPAN::Frontend->myprint(sprintf " %-18s [%s]\n", $k, $v);
- }
- $CPAN::Frontend->myprint("\n");
- for $k (sort keys %CPAN::HandleConfig::keys) {
- next unless $k =~ /$qrfilter/;
- CPAN::HandleConfig->prettyprint($k);
- }
- $CPAN::Frontend->myprint("\n");
- } else {
- if (CPAN::HandleConfig->edit(@o_what)) {
- } else {
- $CPAN::Frontend->myprint(qq{Type 'o conf' to view all configuration }.
- qq{items\n\n});
- }
- }
- } elsif ($o_type eq 'debug') {
- my(%valid);
- @o_what = () if defined $o_what[0] && $o_what[0] =~ /help/i;
- if (@o_what) {
- while (@o_what) {
- my($what) = shift @o_what;
- if ($what =~ s/^-// && exists $CPAN::DEBUG{$what}) {
- $CPAN::DEBUG &= $CPAN::DEBUG ^ $CPAN::DEBUG{$what};
- next;
- }
- if ( exists $CPAN::DEBUG{$what} ) {
- $CPAN::DEBUG |= $CPAN::DEBUG{$what};
- } elsif ($what =~ /^\d/) {
- $CPAN::DEBUG = $what;
- } elsif (lc $what eq 'all') {
- my($max) = 0;
- for (values %CPAN::DEBUG) {
- $max += $_;
- }
- $CPAN::DEBUG = $max;
- } else {
- my($known) = 0;
- for (keys %CPAN::DEBUG) {
- next unless lc($_) eq lc($what);
- $CPAN::DEBUG |= $CPAN::DEBUG{$_};
- $known = 1;
- }
- $CPAN::Frontend->myprint("unknown argument [$what]\n")
- unless $known;
- }
- }
- } else {
- my $raw = "Valid options for debug are ".
- join(", ",sort(keys %CPAN::DEBUG), 'all').
- qq{ or a number. Completion works on the options. }.
- qq{Case is ignored.};
- require Text::Wrap;
- $CPAN::Frontend->myprint(Text::Wrap::fill("","",$raw));
- $CPAN::Frontend->myprint("\n\n");
- }
- if ($CPAN::DEBUG) {
- $CPAN::Frontend->myprint("Options set for debugging ($CPAN::DEBUG):\n");
- my($k,$v);
- for $k (sort {$CPAN::DEBUG{$a} <=> $CPAN::DEBUG{$b}} keys %CPAN::DEBUG) {
- $v = $CPAN::DEBUG{$k};
- $CPAN::Frontend->myprint(sprintf " %-14s(%s)\n", $k, $v)
- if $v & $CPAN::DEBUG;
- }
- } else {
- $CPAN::Frontend->myprint("Debugging turned off completely.\n");
- }
- } else {
- $CPAN::Frontend->myprint(qq{
-Known options:
- conf set or get configuration variables
- debug set or get debugging options
-});
- }
-}
-
-# CPAN::Shell::paintdots_onreload
-sub paintdots_onreload {
- my($ref) = shift;
- sub {
- if ( $_[0] =~ /[Ss]ubroutine ([\w:]+) redefined/ ) {
- my($subr) = $1;
- ++$$ref;
- local($|) = 1;
- # $CPAN::Frontend->myprint(".($subr)");
- $CPAN::Frontend->myprint(".");
- if ($subr =~ /\bshell\b/i) {
- # warn "debug[$_[0]]";
-
- # It would be nice if we could detect that a
- # subroutine has actually changed, but for now we
- # practically always set the GOTOSHELL global
-
- $CPAN::GOTOSHELL=1;
- }
- return;
- }
- warn @_;
- };
-}
-
-#-> sub CPAN::Shell::hosts ;
-sub hosts {
- my($self) = @_;
- my $fullstats = CPAN::FTP->_ftp_statistics();
- my $history = $fullstats->{history} || [];
- my %S; # statistics
- while (my $last = pop @$history) {
- my $attempts = $last->{attempts} or next;
- my $start;
- if (@$attempts) {
- $start = $attempts->[-1]{start};
- if ($#$attempts > 0) {
- for my $i (0..$#$attempts-1) {
- my $url = $attempts->[$i]{url} or next;
- $S{no}{$url}++;
- }
- }
- } else {
- $start = $last->{start};
- }
- next unless $last->{thesiteurl}; # C-C? bad filenames?
- $S{start} = $start;
- $S{end} ||= $last->{end};
- my $dltime = $last->{end} - $start;
- my $dlsize = $last->{filesize} || 0;
- my $url = ref $last->{thesiteurl} ? $last->{thesiteurl}->text : $last->{thesiteurl};
- my $s = $S{ok}{$url} ||= {};
- $s->{n}++;
- $s->{dlsize} ||= 0;
- $s->{dlsize} += $dlsize/1024;
- $s->{dltime} ||= 0;
- $s->{dltime} += $dltime;
- }
- my $res;
- for my $url (keys %{$S{ok}}) {
- next if $S{ok}{$url}{dltime} == 0; # div by zero
- push @{$res->{ok}}, [@{$S{ok}{$url}}{qw(n dlsize dltime)},
- $S{ok}{$url}{dlsize}/$S{ok}{$url}{dltime},
- $url,
- ];
- }
- for my $url (keys %{$S{no}}) {
- push @{$res->{no}}, [$S{no}{$url},
- $url,
- ];
- }
- my $R = ""; # report
- if ($S{start} && $S{end}) {
- $R .= sprintf "Log starts: %s\n", $S{start} ? scalar(localtime $S{start}) : "unknown";
- $R .= sprintf "Log ends : %s\n", $S{end} ? scalar(localtime $S{end}) : "unknown";
- }
- if ($res->{ok} && @{$res->{ok}}) {
- $R .= sprintf "\nSuccessful downloads:
- N kB secs kB/s url\n";
- my $i = 20;
- for (sort { $b->[3] <=> $a->[3] } @{$res->{ok}}) {
- $R .= sprintf "%4d %8d %5d %9.1f %s\n", @$_;
- last if --$i<=0;
- }
- }
- if ($res->{no} && @{$res->{no}}) {
- $R .= sprintf "\nUnsuccessful downloads:\n";
- my $i = 20;
- for (sort { $b->[0] <=> $a->[0] } @{$res->{no}}) {
- $R .= sprintf "%4d %s\n", @$_;
- last if --$i<=0;
- }
- }
- $CPAN::Frontend->myprint($R);
-}
-
-#-> sub CPAN::Shell::reload ;
-sub reload {
- my($self,$command,@arg) = @_;
- $command ||= "";
- $self->debug("self[$self]command[$command]arg[@arg]") if $CPAN::DEBUG;
- if ($command =~ /^cpan$/i) {
- my $redef = 0;
- chdir $CPAN::iCwd if $CPAN::iCwd; # may fail
- my $failed;
- my @relo = (
- "CPAN.pm",
- "CPAN/Debug.pm",
- "CPAN/FirstTime.pm",
- "CPAN/HandleConfig.pm",
- "CPAN/Kwalify.pm",
- "CPAN/Queue.pm",
- "CPAN/Reporter/Config.pm",
- "CPAN/Reporter/History.pm",
- "CPAN/Reporter.pm",
- "CPAN/SQLite.pm",
- "CPAN/Tarzip.pm",
- "CPAN/Version.pm",
- );
- MFILE: for my $f (@relo) {
- next unless exists $INC{$f};
- my $p = $f;
- $p =~ s/\.pm$//;
- $p =~ s|/|::|g;
- $CPAN::Frontend->myprint("($p");
- local($SIG{__WARN__}) = paintdots_onreload(\$redef);
- $self->_reload_this($f) or $failed++;
- my $v = eval "$p\::->VERSION";
- $CPAN::Frontend->myprint("v$v)");
- }
- $CPAN::Frontend->myprint("\n$redef subroutines redefined\n");
- if ($failed) {
- my $errors = $failed == 1 ? "error" : "errors";
- $CPAN::Frontend->mywarn("\n$failed $errors during reload. You better quit ".
- "this session.\n");
- }
- } elsif ($command =~ /^index$/i) {
- CPAN::Index->force_reload;
- } else {
- $CPAN::Frontend->myprint(qq{cpan re-evals the CPAN modules
-index re-reads the index files\n});
- }
-}
-
-# reload means only load again what we have loaded before
-#-> sub CPAN::Shell::_reload_this ;
-sub _reload_this {
- my($self,$f,$args) = @_;
- CPAN->debug("f[$f]") if $CPAN::DEBUG;
- return 1 unless $INC{$f}; # we never loaded this, so we do not
- # reload but say OK
- my $pwd = CPAN::anycwd();
- CPAN->debug("pwd[$pwd]") if $CPAN::DEBUG;
- my($file);
- for my $inc (@INC) {
- $file = File::Spec->catfile($inc,split /\//, $f);
- last if -f $file;
- $file = "";
- }
- CPAN->debug("file[$file]") if $CPAN::DEBUG;
- my @inc = @INC;
- unless ($file && -f $file) {
- # this thingie is not in the INC path, maybe CPAN/MyConfig.pm?
- $file = $INC{$f};
- unless (CPAN->has_inst("File::Basename")) {
- @inc = File::Basename::dirname($file);
- } else {
- # do we ever need this?
- @inc = substr($file,0,-length($f)-1); # bring in back to me!
- }
- }
- CPAN->debug("file[$file]inc[@inc]") if $CPAN::DEBUG;
- unless (-f $file) {
- $CPAN::Frontend->mywarn("Found no file to reload for '$f'\n");
- return;
- }
- my $mtime = (stat $file)[9];
- if ($reload->{$f}) {
- } elsif ($^T < $mtime) {
- # since we started the file has changed, force it to be reloaded
- $reload->{$f} = -1;
- } else {
- $reload->{$f} = $mtime;
- }
- my $must_reload = $mtime != $reload->{$f};
- $args ||= {};
- $must_reload ||= $args->{reloforce}; # o conf defaults needs this
- if ($must_reload) {
- my $fh = FileHandle->new($file) or
- $CPAN::Frontend->mydie("Could not open $file: $!");
- local($/);
- local $^W = 1;
- my $content = <$fh>;
- CPAN->debug(sprintf("reload file[%s] content[%s...]",$file,substr($content,0,128)))
- if $CPAN::DEBUG;
- delete $INC{$f};
- local @INC = @inc;
- eval "require '$f'";
- if ($@) {
- warn $@;
- return;
- }
- $reload->{$f} = $mtime;
- } else {
- $CPAN::Frontend->myprint("__unchanged__");
- }
- return 1;
-}
-
-#-> sub CPAN::Shell::mkmyconfig ;
-sub mkmyconfig {
- my($self, $cpanpm, %args) = @_;
- require CPAN::FirstTime;
- my $home = CPAN::HandleConfig::home;
- $cpanpm = $INC{'CPAN/MyConfig.pm'} ||
- File::Spec->catfile(split /\//, "$home/.cpan/CPAN/MyConfig.pm");
- File::Path::mkpath(File::Basename::dirname($cpanpm)) unless -e $cpanpm;
- CPAN::HandleConfig::require_myconfig_or_config;
- $CPAN::Config ||= {};
- $CPAN::Config = {
- %$CPAN::Config,
- build_dir => undef,
- cpan_home => undef,
- keep_source_where => undef,
- histfile => undef,
- };
- CPAN::FirstTime::init($cpanpm, %args);
-}
-
-#-> sub CPAN::Shell::_binary_extensions ;
-sub _binary_extensions {
- my($self) = shift @_;
- my(@result,$module,%seen,%need,$headerdone);
- for $module ($self->expand('Module','/./')) {
- my $file = $module->cpan_file;
- next if $file eq "N/A";
- next if $file =~ /^Contact Author/;
- my $dist = $CPAN::META->instance('CPAN::Distribution',$file);
- next if $dist->isa_perl;
- next unless $module->xs_file;
- local($|) = 1;
- $CPAN::Frontend->myprint(".");
- push @result, $module;
- }
-# print join " | ", @result;
- $CPAN::Frontend->myprint("\n");
- return @result;
-}
-
-#-> sub CPAN::Shell::recompile ;
-sub recompile {
- my($self) = shift @_;
- my($module,@module,$cpan_file,%dist);
- @module = $self->_binary_extensions();
- for $module (@module) { # we force now and compile later, so we
- # don't do it twice
- $cpan_file = $module->cpan_file;
- my $pack = $CPAN::META->instance('CPAN::Distribution',$cpan_file);
- $pack->force;
- $dist{$cpan_file}++;
- }
- for $cpan_file (sort keys %dist) {
- $CPAN::Frontend->myprint(" CPAN: Recompiling $cpan_file\n\n");
- my $pack = $CPAN::META->instance('CPAN::Distribution',$cpan_file);
- $pack->install;
- $CPAN::Signal = 0; # it's tempting to reset Signal, so we can
- # stop a package from recompiling,
- # e.g. IO-1.12 when we have perl5.003_10
- }
-}
-
-#-> sub CPAN::Shell::scripts ;
-sub scripts {
- my($self, $arg) = @_;
- $CPAN::Frontend->mywarn(">>>> experimental command, currently unsupported <<<<\n\n");
-
- for my $req (qw( HTML::LinkExtor Sort::Versions List::Util )) {
- unless ($CPAN::META->has_inst($req)) {
- $CPAN::Frontend->mywarn(" $req not available\n");
- }
- }
- my $p = HTML::LinkExtor->new();
- my $indexfile = "/home/ftp/pub/PAUSE/scripts/new/index.html";
- unless (-f $indexfile) {
- $CPAN::Frontend->mydie("found no indexfile[$indexfile]\n");
- }
- $p->parse_file($indexfile);
- my @hrefs;
- my $qrarg;
- if ($arg =~ s|^/(.+)/$|$1|) {
- $qrarg = eval 'qr/$arg/'; # hide construct from 5.004
- }
- for my $l ($p->links) {
- my $tag = shift @$l;
- next unless $tag eq "a";
- my %att = @$l;
- my $href = $att{href};
- next unless $href =~ s|^\.\./authors/id/./../||;
- if ($arg) {
- if ($qrarg) {
- if ($href =~ $qrarg) {
- push @hrefs, $href;
- }
- } else {
- if ($href =~ /\Q$arg\E/) {
- push @hrefs, $href;
- }
- }
- } else {
- push @hrefs, $href;
- }
- }
- # now filter for the latest version if there is more than one of a name
- my %stems;
- for (sort @hrefs) {
- my $href = $_;
- s/-v?\d.*//;
- my $stem = $_;
- $stems{$stem} ||= [];
- push @{$stems{$stem}}, $href;
- }
- for (sort keys %stems) {
- my $highest;
- if (@{$stems{$_}} > 1) {
- $highest = List::Util::reduce {
- Sort::Versions::versioncmp($a,$b) > 0 ? $a : $b
- } @{$stems{$_}};
- } else {
- $highest = $stems{$_}[0];
- }
- $CPAN::Frontend->myprint("$highest\n");
- }
-}
-
-#-> sub CPAN::Shell::report ;
-sub report {
- my($self,@args) = @_;
- unless ($CPAN::META->has_inst("CPAN::Reporter")) {
- $CPAN::Frontend->mydie("CPAN::Reporter not installed; cannot continue");
- }
- local $CPAN::Config->{test_report} = 1;
- $self->force("test",@args); # force is there so that the test be
- # re-run (as documented)
-}
-
-# compare with is_tested
-#-> sub CPAN::Shell::install_tested
-sub install_tested {
- my($self,@some) = @_;
- $CPAN::Frontend->mywarn("install_tested() must not be called with arguments.\n"),
- return if @some;
- CPAN::Index->reload;
-
- for my $b (reverse $CPAN::META->_list_sorted_descending_is_tested) {
- my $yaml = "$b.yml";
- unless (-f $yaml) {
- $CPAN::Frontend->mywarn("No YAML file for $b available, skipping\n");
- next;
- }
- my $yaml_content = CPAN->_yaml_loadfile($yaml);
- my $id = $yaml_content->[0]{distribution}{ID};
- unless ($id) {
- $CPAN::Frontend->mywarn("No ID found in '$yaml', skipping\n");
- next;
- }
- my $do = CPAN::Shell->expandany($id);
- unless ($do) {
- $CPAN::Frontend->mywarn("Could not expand ID '$id', skipping\n");
- next;
- }
- unless ($do->{build_dir}) {
- $CPAN::Frontend->mywarn("Distro '$id' has no build_dir, skipping\n");
- next;
- }
- unless ($do->{build_dir} eq $b) {
- $CPAN::Frontend->mywarn("Distro '$id' has build_dir '$do->{build_dir}' but expected '$b', skipping\n");
- next;
- }
- push @some, $do;
- }
-
- $CPAN::Frontend->mywarn("No tested distributions found.\n"),
- return unless @some;
-
- @some = grep { $_->{make_test} && ! $_->{make_test}->failed } @some;
- $CPAN::Frontend->mywarn("No distributions tested with this build of perl found.\n"),
- return unless @some;
-
- # @some = grep { not $_->uptodate } @some;
- # $CPAN::Frontend->mywarn("No non-uptodate distributions tested with this build of perl found.\n"),
- # return unless @some;
-
- CPAN->debug("some[@some]");
- for my $d (@some) {
- my $id = $d->can("pretty_id") ? $d->pretty_id : $d->id;
- $CPAN::Frontend->myprint("install_tested: Running for $id\n");
- $CPAN::Frontend->mysleep(1);
- $self->install($d);
- }
-}
-
-#-> sub CPAN::Shell::upgrade ;
-sub upgrade {
- my($self,@args) = @_;
- $self->install($self->r(@args));
-}
-
-#-> sub CPAN::Shell::_u_r_common ;
-sub _u_r_common {
- my($self) = shift @_;
- my($what) = shift @_;
- CPAN->debug("self[$self] what[$what] args[@_]") if $CPAN::DEBUG;
- Carp::croak "Usage: \$obj->_u_r_common(a|r|u)" unless
- $what && $what =~ /^[aru]$/;
- my(@args) = @_;
- @args = '/./' unless @args;
- my(@result,$module,%seen,%need,$headerdone,
- $version_undefs,$version_zeroes,
- @version_undefs,@version_zeroes);
- $version_undefs = $version_zeroes = 0;
- my $sprintf = "%s%-25s%s %9s %9s %s\n";
- my @expand = $self->expand('Module',@args);
- my $expand = scalar @expand;
- if (0) { # Looks like noise to me, was very useful for debugging
- # for metadata cache
- $CPAN::Frontend->myprint(sprintf "%d matches in the database\n", $expand);
- }
- MODULE: for $module (@expand) {
- my $file = $module->cpan_file;
- next MODULE unless defined $file; # ??
- $file =~ s!^./../!!;
- my($latest) = $module->cpan_version;
- my($inst_file) = $module->inst_file;
- my($have);
- return if $CPAN::Signal;
- if ($inst_file) {
- if ($what eq "a") {
- $have = $module->inst_version;
- } elsif ($what eq "r") {
- $have = $module->inst_version;
- local($^W) = 0;
- if ($have eq "undef") {
- $version_undefs++;
- push @version_undefs, $module->as_glimpse;
- } elsif (CPAN::Version->vcmp($have,0)==0) {
- $version_zeroes++;
- push @version_zeroes, $module->as_glimpse;
- }
- next MODULE unless CPAN::Version->vgt($latest, $have);
-# to be pedantic we should probably say:
-# && !($have eq "undef" && $latest ne "undef" && $latest gt "");
-# to catch the case where CPAN has a version 0 and we have a version undef
- } elsif ($what eq "u") {
- next MODULE;
- }
- } else {
- if ($what eq "a") {
- next MODULE;
- } elsif ($what eq "r") {
- next MODULE;
- } elsif ($what eq "u") {
- $have = "-";
- }
- }
- return if $CPAN::Signal; # this is sometimes lengthy
- $seen{$file} ||= 0;
- if ($what eq "a") {
- push @result, sprintf "%s %s\n", $module->id, $have;
- } elsif ($what eq "r") {
- push @result, $module->id;
- next MODULE if $seen{$file}++;
- } elsif ($what eq "u") {
- push @result, $module->id;
- next MODULE if $seen{$file}++;
- next MODULE if $file =~ /^Contact/;
- }
- unless ($headerdone++) {
- $CPAN::Frontend->myprint("\n");
- $CPAN::Frontend->myprint(sprintf(
- $sprintf,
- "",
- "Package namespace",
- "",
- "installed",
- "latest",
- "in CPAN file"
- ));
- }
- my $color_on = "";
- my $color_off = "";
- if (
- $COLOR_REGISTERED
- &&
- $CPAN::META->has_inst("Term::ANSIColor")
- &&
- $module->description
- ) {
- $color_on = Term::ANSIColor::color("green");
- $color_off = Term::ANSIColor::color("reset");
- }
- $CPAN::Frontend->myprint(sprintf $sprintf,
- $color_on,
- $module->id,
- $color_off,
- $have,
- $latest,
- $file);
- $need{$module->id}++;
- }
- unless (%need) {
- if ($what eq "u") {
- $CPAN::Frontend->myprint("No modules found for @args\n");
- } elsif ($what eq "r") {
- $CPAN::Frontend->myprint("All modules are up to date for @args\n");
- }
- }
- if ($what eq "r") {
- if ($version_zeroes) {
- my $s_has = $version_zeroes > 1 ? "s have" : " has";
- $CPAN::Frontend->myprint(qq{$version_zeroes installed module$s_has }.
- qq{a version number of 0\n});
- if ($CPAN::Config->{show_zero_versions}) {
- local $" = "\t";
- $CPAN::Frontend->myprint(qq{ they are\n\t@version_zeroes\n});
- $CPAN::Frontend->myprint(qq{(use 'o conf show_zero_versions 0' }.
- qq{to hide them)\n});
- } else {
- $CPAN::Frontend->myprint(qq{(use 'o conf show_zero_versions 1' }.
- qq{to show them)\n});
- }
- }
- if ($version_undefs) {
- my $s_has = $version_undefs > 1 ? "s have" : " has";
- $CPAN::Frontend->myprint(qq{$version_undefs installed module$s_has no }.
- qq{parseable version number\n});
- if ($CPAN::Config->{show_unparsable_versions}) {
- local $" = "\t";
- $CPAN::Frontend->myprint(qq{ they are\n\t@version_undefs\n});
- $CPAN::Frontend->myprint(qq{(use 'o conf show_unparsable_versions 0' }.
- qq{to hide them)\n});
- } else {
- $CPAN::Frontend->myprint(qq{(use 'o conf show_unparsable_versions 1' }.
- qq{to show them)\n});
- }
- }
- }
- @result;
-}
-
-#-> sub CPAN::Shell::r ;
-sub r {
- shift->_u_r_common("r",@_);
-}
-
-#-> sub CPAN::Shell::u ;
-sub u {
- shift->_u_r_common("u",@_);
-}
-
-#-> sub CPAN::Shell::failed ;
-sub failed {
- my($self,$only_id,$silent) = @_;
- my @failed;
- DIST: for my $d ($CPAN::META->all_objects("CPAN::Distribution")) {
- my $failed = "";
- NAY: for my $nosayer ( # order matters!
- "unwrapped",
- "writemakefile",
- "signature_verify",
- "make",
- "make_test",
- "install",
- "make_clean",
- ) {
- next unless exists $d->{$nosayer};
- next unless defined $d->{$nosayer};
- next unless (
- UNIVERSAL::can($d->{$nosayer},"failed") ?
- $d->{$nosayer}->failed :
- $d->{$nosayer} =~ /^NO/
- );
- next NAY if $only_id && $only_id != (
- UNIVERSAL::can($d->{$nosayer},"commandid")
- ?
- $d->{$nosayer}->commandid
- :
- $CPAN::CurrentCommandId
- );
- $failed = $nosayer;
- last;
- }
- next DIST unless $failed;
- my $id = $d->id;
- $id =~ s|^./../||;
- #$print .= sprintf(
- # " %-45s: %s %s\n",
- push @failed,
- (
- UNIVERSAL::can($d->{$failed},"failed") ?
- [
- $d->{$failed}->commandid,
- $id,
- $failed,
- $d->{$failed}->text,
- $d->{$failed}{TIME}||0,
- ] :
- [
- 1,
- $id,
- $failed,
- $d->{$failed},
- 0,
- ]
- );
- }
- my $scope;
- if ($only_id) {
- $scope = "this command";
- } elsif ($CPAN::Index::HAVE_REANIMATED) {
- $scope = "this or a previous session";
- # it might be nice to have a section for previous session and
- # a second for this
- } else {
- $scope = "this session";
- }
- if (@failed) {
- my $print;
- my $debug = 0;
- if ($debug) {
- $print = join "",
- map { sprintf "%5d %-45s: %s %s\n", @$_ }
- sort { $a->[0] <=> $b->[0] } @failed;
- } else {
- $print = join "",
- map { sprintf " %-45s: %s %s\n", @$_[1..3] }
- sort {
- $a->[0] <=> $b->[0]
- ||
- $a->[4] <=> $b->[4]
- } @failed;
- }
- $CPAN::Frontend->myprint("Failed during $scope:\n$print");
- } elsif (!$only_id || !$silent) {
- $CPAN::Frontend->myprint("Nothing failed in $scope\n");
- }
-}
-
-# XXX intentionally undocumented because completely bogus, unportable,
-# useless, etc.
-
-#-> sub CPAN::Shell::status ;
-sub status {
- my($self) = @_;
- require Devel::Size;
- my $ps = FileHandle->new;
- open $ps, "/proc/$$/status";
- my $vm = 0;
- while (<$ps>) {
- next unless /VmSize:\s+(\d+)/;
- $vm = $1;
- last;
- }
- $CPAN::Frontend->mywarn(sprintf(
- "%-27s %6d\n%-27s %6d\n",
- "vm",
- $vm,
- "CPAN::META",
- Devel::Size::total_size($CPAN::META)/1024,
- ));
- for my $k (sort keys %$CPAN::META) {
- next unless substr($k,0,4) eq "read";
- warn sprintf " %-26s %6d\n", $k, Devel::Size::total_size($CPAN::META->{$k})/1024;
- for my $k2 (sort keys %{$CPAN::META->{$k}}) {
- warn sprintf " %-25s %6d (keys: %6d)\n",
- $k2,
- Devel::Size::total_size($CPAN::META->{$k}{$k2})/1024,
- scalar keys %{$CPAN::META->{$k}{$k2}};
- }
- }
-}
-
-# compare with install_tested
-#-> sub CPAN::Shell::is_tested
-sub is_tested {
- my($self) = @_;
- CPAN::Index->reload;
- for my $b (reverse $CPAN::META->_list_sorted_descending_is_tested) {
- my $time;
- if ($CPAN::META->{is_tested}{$b}) {
- $time = scalar(localtime $CPAN::META->{is_tested}{$b});
- } else {
- $time = scalar localtime;
- $time =~ s/\S/?/g;
- }
- $CPAN::Frontend->myprint(sprintf "%s %s\n", $time, $b);
- }
-}
-
-#-> sub CPAN::Shell::autobundle ;
-sub autobundle {
- my($self) = shift;
- CPAN::HandleConfig->load unless $CPAN::Config_loaded++;
- my(@bundle) = $self->_u_r_common("a",@_);
- my($todir) = File::Spec->catdir($CPAN::Config->{'cpan_home'},"Bundle");
- File::Path::mkpath($todir);
- unless (-d $todir) {
- $CPAN::Frontend->myprint("Couldn't mkdir $todir for some reason\n");
- return;
- }
- my($y,$m,$d) = (localtime)[5,4,3];
- $y+=1900;
- $m++;
- my($c) = 0;
- my($me) = sprintf "Snapshot_%04d_%02d_%02d_%02d", $y, $m, $d, $c;
- my($to) = File::Spec->catfile($todir,"$me.pm");
- while (-f $to) {
- $me = sprintf "Snapshot_%04d_%02d_%02d_%02d", $y, $m, $d, ++$c;
- $to = File::Spec->catfile($todir,"$me.pm");
- }
- my($fh) = FileHandle->new(">$to") or Carp::croak "Can't open >$to: $!";
- $fh->print(
- "package Bundle::$me;\n\n",
- "\$VERSION = '0.01';\n\n",
- "1;\n\n",
- "__END__\n\n",
- "=head1 NAME\n\n",
- "Bundle::$me - Snapshot of installation on ",
- $Config::Config{'myhostname'},
- " on ",
- scalar(localtime),
- "\n\n=head1 SYNOPSIS\n\n",
- "perl -MCPAN -e 'install Bundle::$me'\n\n",
- "=head1 CONTENTS\n\n",
- join("\n", @bundle),
- "\n\n=head1 CONFIGURATION\n\n",
- Config->myconfig,
- "\n\n=head1 AUTHOR\n\n",
- "This Bundle has been generated automatically ",
- "by the autobundle routine in CPAN.pm.\n",
- );
- $fh->close;
- $CPAN::Frontend->myprint("\nWrote bundle file
- $to\n\n");
-}
-
-#-> sub CPAN::Shell::expandany ;
-sub expandany {
- my($self,$s) = @_;
- CPAN->debug("s[$s]") if $CPAN::DEBUG;
- if ($s =~ m|/| or substr($s,-1,1) eq ".") { # looks like a file or a directory
- $s = CPAN::Distribution->normalize($s);
- return $CPAN::META->instance('CPAN::Distribution',$s);
- # Distributions spring into existence, not expand
- } elsif ($s =~ m|^Bundle::|) {
- $self->local_bundles; # scanning so late for bundles seems
- # both attractive and crumpy: always
- # current state but easy to forget
- # somewhere
- return $self->expand('Bundle',$s);
- } else {
- return $self->expand('Module',$s)
- if $CPAN::META->exists('CPAN::Module',$s);
- }
- return;
-}
-
-#-> sub CPAN::Shell::expand ;
-sub expand {
- my $self = shift;
- my($type,@args) = @_;
- CPAN->debug("type[$type]args[@args]") if $CPAN::DEBUG;
- my $class = "CPAN::$type";
- my $methods = ['id'];
- for my $meth (qw(name)) {
- next unless $class->can($meth);
- push @$methods, $meth;
- }
- $self->expand_by_method($class,$methods,@args);
-}
-
-#-> sub CPAN::Shell::expand_by_method ;
-sub expand_by_method {
- my $self = shift;
- my($class,$methods,@args) = @_;
- my($arg,@m);
- for $arg (@args) {
- my($regex,$command);
- if ($arg =~ m|^/(.*)/$|) {
- $regex = $1;
-# FIXME: there seem to be some ='s in the author data, which trigger
-# a failure here. This needs to be contemplated.
-# } elsif ($arg =~ m/=/) {
-# $command = 1;
- }
- my $obj;
- CPAN->debug(sprintf "class[%s]regex[%s]command[%s]",
- $class,
- defined $regex ? $regex : "UNDEFINED",
- defined $command ? $command : "UNDEFINED",
- ) if $CPAN::DEBUG;
- if (defined $regex) {
- if (CPAN::_sqlite_running) {
- $CPAN::SQLite->search($class, $regex);
- }
- for $obj (
- $CPAN::META->all_objects($class)
- ) {
- unless ($obj && UNIVERSAL::can($obj,"id") && $obj->id) {
- # BUG, we got an empty object somewhere
- require Data::Dumper;
- CPAN->debug(sprintf(
- "Bug in CPAN: Empty id on obj[%s][%s]",
- $obj,
- Data::Dumper::Dumper($obj)
- )) if $CPAN::DEBUG;
- next;
- }
- for my $method (@$methods) {
- my $match = eval {$obj->$method() =~ /$regex/i};
- if ($@) {
- my($err) = $@ =~ /^(.+) at .+? line \d+\.$/;
- $err ||= $@; # if we were too restrictive above
- $CPAN::Frontend->mydie("$err\n");
- } elsif ($match) {
- push @m, $obj;
- last;
- }
- }
- }
- } elsif ($command) {
- die "equal sign in command disabled (immature interface), ".
- "you can set
- ! \$CPAN::Shell::ADVANCED_QUERY=1
-to enable it. But please note, this is HIGHLY EXPERIMENTAL code
-that may go away anytime.\n"
- unless $ADVANCED_QUERY;
- my($method,$criterion) = $arg =~ /(.+?)=(.+)/;
- my($matchcrit) = $criterion =~ m/^~(.+)/;
- for my $self (
- sort
- {$a->id cmp $b->id}
- $CPAN::META->all_objects($class)
- ) {
- my $lhs = $self->$method() or next; # () for 5.00503
- if ($matchcrit) {
- push @m, $self if $lhs =~ m/$matchcrit/;
- } else {
- push @m, $self if $lhs eq $criterion;
- }
- }
- } else {
- my($xarg) = $arg;
- if ( $class eq 'CPAN::Bundle' ) {
- $xarg =~ s/^(Bundle::)?(.*)/Bundle::$2/;
- } elsif ($class eq "CPAN::Distribution") {
- $xarg = CPAN::Distribution->normalize($arg);
- } else {
- $xarg =~ s/:+/::/g;
- }
- if ($CPAN::META->exists($class,$xarg)) {
- $obj = $CPAN::META->instance($class,$xarg);
- } elsif ($CPAN::META->exists($class,$arg)) {
- $obj = $CPAN::META->instance($class,$arg);
- } else {
- next;
- }
- push @m, $obj;
- }
- }
- @m = sort {$a->id cmp $b->id} @m;
- if ( $CPAN::DEBUG ) {
- my $wantarray = wantarray;
- my $join_m = join ",", map {$_->id} @m;
- $self->debug("wantarray[$wantarray]join_m[$join_m]");
- }
- return wantarray ? @m : $m[0];
-}
-
-#-> sub CPAN::Shell::format_result ;
-sub format_result {
- my($self) = shift;
- my($type,@args) = @_;
- @args = '/./' unless @args;
- my(@result) = $self->expand($type,@args);
- my $result = @result == 1 ?
- $result[0]->as_string :
- @result == 0 ?
- "No objects of type $type found for argument @args\n" :
- join("",
- (map {$_->as_glimpse} @result),
- scalar @result, " items found\n",
- );
- $result;
-}
-
-#-> sub CPAN::Shell::report_fh ;
-{
- my $installation_report_fh;
- my $previously_noticed = 0;
-
- sub report_fh {
- return $installation_report_fh if $installation_report_fh;
- if ($CPAN::META->has_usable("File::Temp")) {
- $installation_report_fh
- = File::Temp->new(
- dir => File::Spec->tmpdir,
- template => 'cpan_install_XXXX',
- suffix => '.txt',
- unlink => 0,
- );
- }
- unless ( $installation_report_fh ) {
- warn("Couldn't open installation report file; " .
- "no report file will be generated."
- ) unless $previously_noticed++;
- }
- }
-}
-
-
-# The only reason for this method is currently to have a reliable
-# debugging utility that reveals which output is going through which
-# channel. No, I don't like the colors ;-)
-
-# to turn colordebugging on, write
-# cpan> o conf colorize_output 1
-
-#-> sub CPAN::Shell::print_ornamented ;
-{
- my $print_ornamented_have_warned = 0;
- sub colorize_output {
- my $colorize_output = $CPAN::Config->{colorize_output};
- if ($colorize_output && !$CPAN::META->has_inst("Term::ANSIColor")) {
- unless ($print_ornamented_have_warned++) {
- # no myprint/mywarn within myprint/mywarn!
- warn "Colorize_output is set to true but Term::ANSIColor is not
-installed. To activate colorized output, please install Term::ANSIColor.\n\n";
- }
- $colorize_output = 0;
- }
- return $colorize_output;
- }
-}
-
-
-#-> sub CPAN::Shell::print_ornamented ;
-sub print_ornamented {
- my($self,$what,$ornament) = @_;
- return unless defined $what;
-
- local $| = 1; # Flush immediately
- if ( $CPAN::Be_Silent ) {
- print {report_fh()} $what;
- return;
- }
- my $swhat = "$what"; # stringify if it is an object
- if ($CPAN::Config->{term_is_latin}) {
- # note: deprecated, need to switch to $LANG and $LC_*
- # courtesy jhi:
- $swhat
- =~ s{([\xC0-\xDF])([\x80-\xBF])}{chr(ord($1)<<6&0xC0|ord($2)&0x3F)}eg; #};
- }
- if ($self->colorize_output) {
- if ( $CPAN::DEBUG && $swhat =~ /^Debug\(/ ) {
- # if you want to have this configurable, please file a bugreport
- $ornament = $CPAN::Config->{colorize_debug} || "black on_cyan";
- }
- my $color_on = eval { Term::ANSIColor::color($ornament) } || "";
- if ($@) {
- print "Term::ANSIColor rejects color[$ornament]: $@\n
-Please choose a different color (Hint: try 'o conf init /color/')\n";
- }
- # GGOLDBACH/Test-GreaterVersion-0.008 broke wthout this
- # $trailer construct. We want the newline be the last thing if
- # there is a newline at the end ensuring that the next line is
- # empty for other players
- my $trailer = "";
- $trailer = $1 if $swhat =~ s/([\r\n]+)\z//;
- print $color_on,
- $swhat,
- Term::ANSIColor::color("reset"),
- $trailer;
- } else {
- print $swhat;
- }
-}
-
-#-> sub CPAN::Shell::myprint ;
-
-# where is myprint/mywarn/Frontend/etc. documented? Where to use what?
-# I think, we send everything to STDOUT and use print for normal/good
-# news and warn for news that need more attention. Yes, this is our
-# working contract for now.
-sub myprint {
- my($self,$what) = @_;
- $self->print_ornamented($what,
- $CPAN::Config->{colorize_print}||'bold blue on_white',
- );
-}
-
-sub optprint {
- my($self,$category,$what) = @_;
- my $vname = $category . "_verbosity";
- CPAN::HandleConfig->load unless $CPAN::Config_loaded++;
- if (!$CPAN::Config->{$vname}
- || $CPAN::Config->{$vname} =~ /^v/
- ) {
- $CPAN::Frontend->myprint($what);
- }
-}
-
-#-> sub CPAN::Shell::myexit ;
-sub myexit {
- my($self,$what) = @_;
- $self->myprint($what);
- exit;
-}
-
-#-> sub CPAN::Shell::mywarn ;
-sub mywarn {
- my($self,$what) = @_;
- $self->print_ornamented($what, $CPAN::Config->{colorize_warn}||'bold red on_white');
-}
-
-# only to be used for shell commands
-#-> sub CPAN::Shell::mydie ;
-sub mydie {
- my($self,$what) = @_;
- $self->mywarn($what);
-
- # If it is the shell, we want the following die to be silent,
- # but if it is not the shell, we would need a 'die $what'. We need
- # to take care that only shell commands use mydie. Is this
- # possible?
-
- die "\n";
-}
-
-# sub CPAN::Shell::colorable_makemaker_prompt ;
-sub colorable_makemaker_prompt {
- my($foo,$bar) = @_;
- if (CPAN::Shell->colorize_output) {
- my $ornament = $CPAN::Config->{colorize_print}||'bold blue on_white';
- my $color_on = eval { Term::ANSIColor::color($ornament); } || "";
- print $color_on;
- }
- my $ans = ExtUtils::MakeMaker::prompt($foo,$bar);
- if (CPAN::Shell->colorize_output) {
- print Term::ANSIColor::color('reset');
- }
- return $ans;
-}
-
-# use this only for unrecoverable errors!
-#-> sub CPAN::Shell::unrecoverable_error ;
-sub unrecoverable_error {
- my($self,$what) = @_;
- my @lines = split /\n/, $what;
- my $longest = 0;
- for my $l (@lines) {
- $longest = length $l if length $l > $longest;
- }
- $longest = 62 if $longest > 62;
- for my $l (@lines) {
- if ($l =~ /^\s*$/) {
- $l = "\n";
- next;
- }
- $l = "==> $l";
- if (length $l < 66) {
- $l = pack "A66 A*", $l, "<==";
- }
- $l .= "\n";
- }
- unshift @lines, "\n";
- $self->mydie(join "", @lines);
-}
-
-#-> sub CPAN::Shell::mysleep ;
-sub mysleep {
- my($self, $sleep) = @_;
- if (CPAN->has_inst("Time::HiRes")) {
- Time::HiRes::sleep($sleep);
- } else {
- sleep($sleep < 1 ? 1 : int($sleep + 0.5));
- }
-}
-
-#-> sub CPAN::Shell::setup_output ;
-sub setup_output {
- return if -t STDOUT;
- my $odef = select STDERR;
- $| = 1;
- select STDOUT;
- $| = 1;
- select $odef;
-}
-
-#-> sub CPAN::Shell::rematein ;
-# RE-adme||MA-ke||TE-st||IN-stall : nearly everything runs through here
-sub rematein {
- my $self = shift;
- my($meth,@some) = @_;
- my @pragma;
- while($meth =~ /^(ff?orce|notest)$/) {
- push @pragma, $meth;
- $meth = shift @some or
- $CPAN::Frontend->mydie("Pragma $pragma[-1] used without method: ".
- "cannot continue");
- }
- setup_output();
- CPAN->debug("pragma[@pragma]meth[$meth]some[@some]") if $CPAN::DEBUG;
-
- # Here is the place to set "test_count" on all involved parties to
- # 0. We then can pass this counter on to the involved
- # distributions and those can refuse to test if test_count > X. In
- # the first stab at it we could use a 1 for "X".
-
- # But when do I reset the distributions to start with 0 again?
- # Jost suggested to have a random or cycling interaction ID that
- # we pass through. But the ID is something that is just left lying
- # around in addition to the counter, so I'd prefer to set the
- # counter to 0 now, and repeat at the end of the loop. But what
- # about dependencies? They appear later and are not reset, they
- # enter the queue but not its copy. How do they get a sensible
- # test_count?
-
- # With configure_requires, "get" is vulnerable in recursion.
-
- my $needs_recursion_protection = "get|make|test|install";
-
- # construct the queue
- my($s,@s,@qcopy);
- STHING: foreach $s (@some) {
- my $obj;
- if (ref $s) {
- CPAN->debug("s is an object[$s]") if $CPAN::DEBUG;
- $obj = $s;
- } elsif ($s =~ m|[\$\@\%]|) { # looks like a perl variable
- } elsif ($s =~ m|^/|) { # looks like a regexp
- if (substr($s,-1,1) eq ".") {
- $obj = CPAN::Shell->expandany($s);
- } else {
- $CPAN::Frontend->mywarn("Sorry, $meth with a regular expression is ".
- "not supported.\nRejecting argument '$s'\n");
- $CPAN::Frontend->mysleep(2);
- next;
- }
- } elsif ($meth eq "ls") {
- $self->globls($s,\@pragma);
- next STHING;
- } else {
- CPAN->debug("calling expandany [$s]") if $CPAN::DEBUG;
- $obj = CPAN::Shell->expandany($s);
- }
- if (0) {
- } elsif (ref $obj) {
- if ($meth =~ /^($needs_recursion_protection)$/) {
- # it would be silly to check for recursion for look or dump
- # (we are in CPAN::Shell::rematein)
- CPAN->debug("Going to test against recursion") if $CPAN::DEBUG;
- eval { $obj->color_cmd_tmps(0,1); };
- if ($@) {
- if (ref $@
- and $@->isa("CPAN::Exception::RecursiveDependency")) {
- $CPAN::Frontend->mywarn($@);
- } else {
- if (0) {
- require Carp;
- Carp::confess(sprintf "DEBUG: \$\@[%s]ref[%s]", $@, ref $@);
- }
- die;
- }
- }
- }
- CPAN::Queue->queue_item(qmod => $obj->id, reqtype => "c");
- push @qcopy, $obj;
- } elsif ($CPAN::META->exists('CPAN::Author',uc($s))) {
- $obj = $CPAN::META->instance('CPAN::Author',uc($s));
- if ($meth =~ /^(dump|ls|reports)$/) {
- $obj->$meth();
- } else {
- $CPAN::Frontend->mywarn(
- join "",
- "Don't be silly, you can't $meth ",
- $obj->fullname,
- " ;-)\n"
- );
- $CPAN::Frontend->mysleep(2);
- }
- } elsif ($s =~ m|[\$\@\%]| && $meth eq "dump") {
- CPAN::InfoObj->dump($s);
- } else {
- $CPAN::Frontend
- ->mywarn(qq{Warning: Cannot $meth $s, }.
- qq{don't know what it is.
-Try the command
-
- i /$s/
-
-to find objects with matching identifiers.
-});
- $CPAN::Frontend->mysleep(2);
- }
- }
-
- # queuerunner (please be warned: when I started to change the
- # queue to hold objects instead of names, I made one or two
- # mistakes and never found which. I reverted back instead)
- while (my $q = CPAN::Queue->first) {
- my $obj;
- my $s = $q->as_string;
- my $reqtype = $q->reqtype || "";
- $obj = CPAN::Shell->expandany($s);
- unless ($obj) {
- # don't know how this can happen, maybe we should panic,
- # but maybe we get a solution from the first user who hits
- # this unfortunate exception?
- $CPAN::Frontend->mywarn("Warning: Could not expand string '$s' ".
- "to an object. Skipping.\n");
- $CPAN::Frontend->mysleep(5);
- CPAN::Queue->delete_first($s);
- next;
- }
- $obj->{reqtype} ||= "";
- {
- # force debugging because CPAN::SQLite somehow delivers us
- # an empty object;
-
- # local $CPAN::DEBUG = 1024; # Shell; probably fixed now
-
- CPAN->debug("s[$s]obj-reqtype[$obj->{reqtype}]".
- "q-reqtype[$reqtype]") if $CPAN::DEBUG;
- }
- if ($obj->{reqtype}) {
- if ($obj->{reqtype} eq "b" && $reqtype =~ /^[rc]$/) {
- $obj->{reqtype} = $reqtype;
- if (
- exists $obj->{install}
- &&
- (
- UNIVERSAL::can($obj->{install},"failed") ?
- $obj->{install}->failed :
- $obj->{install} =~ /^NO/
- )
- ) {
- delete $obj->{install};
- $CPAN::Frontend->mywarn
- ("Promoting $obj->{ID} from 'build_requires' to 'requires'");
- }
- }
- } else {
- $obj->{reqtype} = $reqtype;
- }
-
- for my $pragma (@pragma) {
- if ($pragma
- &&
- $obj->can($pragma)) {
- $obj->$pragma($meth);
- }
- }
- if (UNIVERSAL::can($obj, 'called_for')) {
- $obj->called_for($s);
- }
- CPAN->debug(qq{pragma[@pragma]meth[$meth]}.
- qq{ID[$obj->{ID}]}) if $CPAN::DEBUG;
-
- push @qcopy, $obj;
- if ($meth =~ /^(report)$/) { # they came here with a pragma?
- $self->$meth($obj);
- } elsif (! UNIVERSAL::can($obj,$meth)) {
- # Must never happen
- my $serialized = "";
- if (0) {
- } elsif ($CPAN::META->has_inst("YAML::Syck")) {
- $serialized = YAML::Syck::Dump($obj);
- } elsif ($CPAN::META->has_inst("YAML")) {
- $serialized = YAML::Dump($obj);
- } elsif ($CPAN::META->has_inst("Data::Dumper")) {
- $serialized = Data::Dumper::Dumper($obj);
- } else {
- require overload;
- $serialized = overload::StrVal($obj);
- }
- CPAN->debug("Going to panic. meth[$meth]s[$s]") if $CPAN::DEBUG;
- $CPAN::Frontend->mydie("Panic: obj[$serialized] cannot meth[$meth]");
- } elsif ($obj->$meth()) {
- CPAN::Queue->delete($s);
- CPAN->debug("From queue deleted. meth[$meth]s[$s]") if $CPAN::DEBUG;
- } else {
- CPAN->debug("Failed. pragma[@pragma]meth[$meth]") if $CPAN::DEBUG;
- }
-
- $obj->undelay;
- for my $pragma (@pragma) {
- my $unpragma = "un$pragma";
- if ($obj->can($unpragma)) {
- $obj->$unpragma();
- }
- }
- CPAN::Queue->delete_first($s);
- }
- if ($meth =~ /^($needs_recursion_protection)$/) {
- for my $obj (@qcopy) {
- $obj->color_cmd_tmps(0,0);
- }
- }
-}
-
-#-> sub CPAN::Shell::recent ;
-sub recent {
- my($self) = @_;
- if ($CPAN::META->has_inst("XML::LibXML")) {
- my $url = $CPAN::Defaultrecent;
- $CPAN::Frontend->myprint("Going to fetch '$url'\n");
- unless ($CPAN::META->has_usable("LWP")) {
- $CPAN::Frontend->mydie("LWP not installed; cannot continue");
- }
- CPAN::LWP::UserAgent->config;
- my $Ua;
- eval { $Ua = CPAN::LWP::UserAgent->new; };
- if ($@) {
- $CPAN::Frontend->mydie("CPAN::LWP::UserAgent->new dies with $@\n");
- }
- my $resp = $Ua->get($url);
- unless ($resp->is_success) {
- $CPAN::Frontend->mydie(sprintf "Could not download '%s': %s\n", $url, $resp->code);
- }
- $CPAN::Frontend->myprint("DONE\n\n");
- my $xml = XML::LibXML->new->parse_string($resp->content);
- if (0) {
- my $s = $xml->serialize(2);
- $s =~ s/\n\s*\n/\n/g;
- $CPAN::Frontend->myprint($s);
- return;
- }
- my @distros;
- if ($url =~ /winnipeg/) {
- my $pubdate = $xml->findvalue("/rss/channel/pubDate");
- $CPAN::Frontend->myprint(" pubDate: $pubdate\n\n");
- for my $eitem ($xml->findnodes("/rss/channel/item")) {
- my $distro = $eitem->findvalue("enclosure/\@url");
- $distro =~ s|.*?/authors/id/./../||;
- my $size = $eitem->findvalue("enclosure/\@length");
- my $desc = $eitem->findvalue("description");
-
- $CPAN::Frontend->myprint("$distro [$size b]\n $desc\n");
- push @distros, $distro;
- }
- } elsif ($url =~ /search.*uploads.rdf/) {
- # xmlns:rdf="http://www.w3.org/1999/02/22-rdf-syntax-ns#"
- # xmlns="http://purl.org/rss/1.0/"
- # xmlns:taxo="http://purl.org/rss/1.0/modules/taxonomy/"
- # xmlns:dc="http://purl.org/dc/elements/1.1/"
- # xmlns:syn="http://purl.org/rss/1.0/modules/syndication/"
- # xmlns:admin="http://webns.net/mvcb/"
-
-
- my $dc_date = $xml->findvalue("//*[local-name(.) = 'RDF']/*[local-name(.) = 'channel']/*[local-name(.) = 'date']");
- $CPAN::Frontend->myprint(" dc:date: $dc_date\n\n");
- my $finish_eitem = 0;
- local $SIG{INT} = sub { $finish_eitem = 1 };
- EITEM: for my $eitem ($xml->findnodes("//*[local-name(.) = 'RDF']/*[local-name(.) = 'item']")) {
- my $distro = $eitem->findvalue("\@rdf:about");
- $distro =~ s|.*~||; # remove up to the tilde before the name
- $distro =~ s|/$||; # remove trailing slash
- $distro =~ s|([^/]+)|\U$1\E|; # upcase the name
- my $author = uc $1 or die "distro[$distro] without author, cannot continue";
- my $desc = $eitem->findvalue("*[local-name(.) = 'description']");
- my $i = 0;
- SUBDIRTEST: while () {
- last SUBDIRTEST if ++$i >= 6; # half a dozen must do!
- if (my @ret = $self->globls("$distro*")) {
- @ret = grep {$_->[2] !~ /meta/} @ret;
- @ret = grep {length $_->[2]} @ret;
- if (@ret) {
- $distro = "$author/$ret[0][2]";
- last SUBDIRTEST;
- }
- }
- $distro =~ s|/|/*/|; # allow it to reside in a subdirectory
- }
-
- next EITEM if $distro =~ m|\*|; # did not find the thing
- $CPAN::Frontend->myprint("____$desc\n");
- push @distros, $distro;
- last EITEM if $finish_eitem;
- }
- }
- return \@distros;
- } else {
- # deprecated old version
- $CPAN::Frontend->mydie("no XML::LibXML installed, cannot continue\n");
- }
-}
-
-#-> sub CPAN::Shell::smoke ;
-sub smoke {
- my($self) = @_;
- my $distros = $self->recent;
- DISTRO: for my $distro (@$distros) {
- $CPAN::Frontend->myprint(sprintf "Going to download and test '$distro'\n");
- {
- my $skip = 0;
- local $SIG{INT} = sub { $skip = 1 };
- for (0..9) {
- $CPAN::Frontend->myprint(sprintf "\r%2d (Hit ^C to skip)", 10-$_);
- sleep 1;
- if ($skip) {
- $CPAN::Frontend->myprint(" skipped\n");
- next DISTRO;
- }
- }
- }
- $CPAN::Frontend->myprint("\r \n"); # leave the dirty line with a newline
- $self->test($distro);
- }
-}
-
-{
- # set up the dispatching methods
- no strict "refs";
- for my $command (qw(
- clean
- cvs_import
- dump
- force
- fforce
- get
- install
- look
- ls
- make
- notest
- perldoc
- readme
- reports
- test
- )) {
- *$command = sub { shift->rematein($command, @_); };
- }
-}
-
-package CPAN::LWP::UserAgent;
-use strict;
-
-sub config {
- return if $SETUPDONE;
- if ($CPAN::META->has_usable('LWP::UserAgent')) {
- require LWP::UserAgent;
- @ISA = qw(Exporter LWP::UserAgent);
- $SETUPDONE++;
- } else {
- $CPAN::Frontend->mywarn(" LWP::UserAgent not available\n");
- }
-}
-
-sub get_basic_credentials {
- my($self, $realm, $uri, $proxy) = @_;
- if ($USER && $PASSWD) {
- return ($USER, $PASSWD);
- }
- if ( $proxy ) {
- ($USER,$PASSWD) = $self->get_proxy_credentials();
- } else {
- ($USER,$PASSWD) = $self->get_non_proxy_credentials();
- }
- return($USER,$PASSWD);
-}
-
-sub get_proxy_credentials {
- my $self = shift;
- my ($user, $password);
- if ( defined $CPAN::Config->{proxy_user} &&
- defined $CPAN::Config->{proxy_pass}) {
- $user = $CPAN::Config->{proxy_user};
- $password = $CPAN::Config->{proxy_pass};
- return ($user, $password);
- }
- my $username_prompt = "\nProxy authentication needed!
- (Note: to permanently configure username and password run
- o conf proxy_user your_username
- o conf proxy_pass your_password
- )\nUsername:";
- ($user, $password) =
- _get_username_and_password_from_user($username_prompt);
- return ($user,$password);
-}
-
-sub get_non_proxy_credentials {
- my $self = shift;
- my ($user,$password);
- if ( defined $CPAN::Config->{username} &&
- defined $CPAN::Config->{password}) {
- $user = $CPAN::Config->{username};
- $password = $CPAN::Config->{password};
- return ($user, $password);
- }
- my $username_prompt = "\nAuthentication needed!
- (Note: to permanently configure username and password run
- o conf username your_username
- o conf password your_password
- )\nUsername:";
-
- ($user, $password) =
- _get_username_and_password_from_user($username_prompt);
- return ($user,$password);
-}
-
-sub _get_username_and_password_from_user {
- my $username_message = shift;
- my ($username,$password);
-
- ExtUtils::MakeMaker->import(qw(prompt));
- $username = prompt($username_message);
- if ($CPAN::META->has_inst("Term::ReadKey")) {
- Term::ReadKey::ReadMode("noecho");
- }
- else {
- $CPAN::Frontend->mywarn(
- "Warning: Term::ReadKey seems not to be available, your password will be echoed to the terminal!\n"
- );
- }
- $password = prompt("Password:");
-
- if ($CPAN::META->has_inst("Term::ReadKey")) {
- Term::ReadKey::ReadMode("restore");
- }
- $CPAN::Frontend->myprint("\n\n");
- return ($username,$password);
-}
-
-# mirror(): Its purpose is to deal with proxy authentication. When we
-# call SUPER::mirror, we relly call the mirror method in
-# LWP::UserAgent. LWP::UserAgent will then call
-# $self->get_basic_credentials or some equivalent and this will be
-# $self->dispatched to our own get_basic_credentials method.
-
-# Our own get_basic_credentials sets $USER and $PASSWD, two globals.
-
-# 407 stands for HTTP_PROXY_AUTHENTICATION_REQUIRED. Which means
-# although we have gone through our get_basic_credentials, the proxy
-# server refuses to connect. This could be a case where the username or
-# password has changed in the meantime, so I'm trying once again without
-# $USER and $PASSWD to give the get_basic_credentials routine another
-# chance to set $USER and $PASSWD.
-
-# mirror(): Its purpose is to deal with proxy authentication. When we
-# call SUPER::mirror, we relly call the mirror method in
-# LWP::UserAgent. LWP::UserAgent will then call
-# $self->get_basic_credentials or some equivalent and this will be
-# $self->dispatched to our own get_basic_credentials method.
-
-# Our own get_basic_credentials sets $USER and $PASSWD, two globals.
-
-# 407 stands for HTTP_PROXY_AUTHENTICATION_REQUIRED. Which means
-# although we have gone through our get_basic_credentials, the proxy
-# server refuses to connect. This could be a case where the username or
-# password has changed in the meantime, so I'm trying once again without
-# $USER and $PASSWD to give the get_basic_credentials routine another
-# chance to set $USER and $PASSWD.
-
-sub mirror {
- my($self,$url,$aslocal) = @_;
- my $result = $self->SUPER::mirror($url,$aslocal);
- if ($result->code == 407) {
- undef $USER;
- undef $PASSWD;
- $result = $self->SUPER::mirror($url,$aslocal);
- }
- $result;
-}
-
-package CPAN::FTP;
-use strict;
-
-#-> sub CPAN::FTP::ftp_statistics
-# if they want to rewrite, they need to pass in a filehandle
-sub _ftp_statistics {
- my($self,$fh) = @_;
- my $locktype = $fh ? LOCK_EX : LOCK_SH;
- $fh ||= FileHandle->new;
- my $file = File::Spec->catfile($CPAN::Config->{cpan_home},"FTPstats.yml");
- open $fh, "+>>$file" or $CPAN::Frontend->mydie("Could not open '$file': $!");
- my $sleep = 1;
- my $waitstart;
- while (!CPAN::_flock($fh, $locktype|LOCK_NB)) {
- $waitstart ||= localtime();
- if ($sleep>3) {
- $CPAN::Frontend->mywarn("Waiting for a read lock on '$file' (since $waitstart)\n");
- }
- $CPAN::Frontend->mysleep($sleep);
- if ($sleep <= 3) {
- $sleep+=0.33;
- } elsif ($sleep <=6) {
- $sleep+=0.11;
- }
- }
- my $stats = eval { CPAN->_yaml_loadfile($file); };
- if ($@) {
- if (ref $@) {
- if (ref $@ eq "CPAN::Exception::yaml_not_installed") {
- $CPAN::Frontend->myprint("Warning (usually harmless): $@");
- return;
- } elsif (ref $@ eq "CPAN::Exception::yaml_process_error") {
- $CPAN::Frontend->mydie($@);
- }
- } else {
- $CPAN::Frontend->mydie($@);
- }
- }
- return $stats->[0];
-}
-
-#-> sub CPAN::FTP::_mytime
-sub _mytime () {
- if (CPAN->has_inst("Time::HiRes")) {
- return Time::HiRes::time();
- } else {
- return time;
- }
-}
-
-#-> sub CPAN::FTP::_new_stats
-sub _new_stats {
- my($self,$file) = @_;
- my $ret = {
- file => $file,
- attempts => [],
- start => _mytime,
- };
- $ret;
-}
-
-#-> sub CPAN::FTP::_add_to_statistics
-sub _add_to_statistics {
- my($self,$stats) = @_;
- my $yaml_module = CPAN::_yaml_module;
- $self->debug("yaml_module[$yaml_module]") if $CPAN::DEBUG;
- if ($CPAN::META->has_inst($yaml_module)) {
- $stats->{thesiteurl} = $ThesiteURL;
- if (CPAN->has_inst("Time::HiRes")) {
- $stats->{end} = Time::HiRes::time();
- } else {
- $stats->{end} = time;
- }
- my $fh = FileHandle->new;
- my $time = time;
- my $sdebug = 0;
- my @debug;
- @debug = $time if $sdebug;
- my $fullstats = $self->_ftp_statistics($fh);
- close $fh;
- $fullstats->{history} ||= [];
- push @debug, scalar @{$fullstats->{history}} if $sdebug;
- push @debug, time if $sdebug;
- push @{$fullstats->{history}}, $stats;
- # arbitrary hardcoded constants until somebody demands to have
- # them settable; YAML.pm 0.62 is unacceptably slow with 999;
- # YAML::Syck 0.82 has no noticable performance problem with 999;
- while (
- @{$fullstats->{history}} > 99
- || $time - $fullstats->{history}[0]{start} > 14*86400
- ) {
- shift @{$fullstats->{history}}
- }
- push @debug, scalar @{$fullstats->{history}} if $sdebug;
- push @debug, time if $sdebug;
- push @debug, scalar localtime($fullstats->{history}[0]{start}) if $sdebug;
- # need no eval because if this fails, it is serious
- my $sfile = File::Spec->catfile($CPAN::Config->{cpan_home},"FTPstats.yml");
- CPAN->_yaml_dumpfile("$sfile.$$",$fullstats);
- if ( $sdebug ) {
- local $CPAN::DEBUG = 512; # FTP
- push @debug, time;
- CPAN->debug(sprintf("DEBUG history: before_read[%d]before[%d]at[%d]".
- "after[%d]at[%d]oldest[%s]dumped backat[%d]",
- @debug,
- ));
- }
- # Win32 cannot rename a file to an existing filename
- unlink($sfile) if ($^O eq 'MSWin32');
- rename "$sfile.$$", $sfile
- or $CPAN::Frontend->mydie("Could not rename '$sfile.$$' to '$sfile': $!\n");
- }
-}
-
-# if file is CHECKSUMS, suggest the place where we got the file to be
-# checked from, maybe only for young files?
-#-> sub CPAN::FTP::_recommend_url_for
-sub _recommend_url_for {
- my($self, $file) = @_;
- my $urllist = $self->_get_urllist;
- if ($file =~ s|/CHECKSUMS(.gz)?$||) {
- my $fullstats = $self->_ftp_statistics();
- my $history = $fullstats->{history} || [];
- while (my $last = pop @$history) {
- last if $last->{end} - time > 3600; # only young results are interesting
- next unless $last->{file}; # dirname of nothing dies!
- next unless $file eq File::Basename::dirname($last->{file});
- return $last->{thesiteurl};
- }
- }
- if ($CPAN::Config->{randomize_urllist}
- &&
- rand(1) < $CPAN::Config->{randomize_urllist}
- ) {
- $urllist->[int rand scalar @$urllist];
- } else {
- return ();
- }
-}
-
-#-> sub CPAN::FTP::_get_urllist
-sub _get_urllist {
- my($self) = @_;
- $CPAN::Config->{urllist} ||= [];
- unless (ref $CPAN::Config->{urllist} eq 'ARRAY') {
- $CPAN::Frontend->mywarn("Malformed urllist; ignoring. Configuration file corrupt?\n");
- $CPAN::Config->{urllist} = [];
- }
- my @urllist = grep { defined $_ and length $_ } @{$CPAN::Config->{urllist}};
- for my $u (@urllist) {
- CPAN->debug("u[$u]") if $CPAN::DEBUG;
- if (UNIVERSAL::can($u,"text")) {
- $u->{TEXT} .= "/" unless substr($u->{TEXT},-1) eq "/";
- } else {
- $u .= "/" unless substr($u,-1) eq "/";
- $u = CPAN::URL->new(TEXT => $u, FROM => "USER");
- }
- }
- \@urllist;
-}
-
-#-> sub CPAN::FTP::ftp_get ;
-sub ftp_get {
- my($class,$host,$dir,$file,$target) = @_;
- $class->debug(
- qq[Going to fetch file [$file] from dir [$dir]
- on host [$host] as local [$target]\n]
- ) if $CPAN::DEBUG;
- my $ftp = Net::FTP->new($host);
- unless ($ftp) {
- $CPAN::Frontend->mywarn(" Could not connect to host '$host' with Net::FTP\n");
- return;
- }
- return 0 unless defined $ftp;
- $ftp->debug(1) if $CPAN::DEBUG{'FTP'} & $CPAN::DEBUG;
- $class->debug(qq[Going to login("anonymous","$Config::Config{cf_email}")]);
- unless ( $ftp->login("anonymous",$Config::Config{'cf_email'}) ) {
- my $msg = $ftp->message;
- $CPAN::Frontend->mywarn(" Couldn't login on $host: $msg");
- return;
- }
- unless ( $ftp->cwd($dir) ) {
- my $msg = $ftp->message;
- $CPAN::Frontend->mywarn(" Couldn't cwd $dir: $msg");
- return;
- }
- $ftp->binary;
- $class->debug(qq[Going to ->get("$file","$target")\n]) if $CPAN::DEBUG;
- unless ( $ftp->get($file,$target) ) {
- my $msg = $ftp->message;
- $CPAN::Frontend->mywarn(" Couldn't fetch $file from $host: $msg");
- return;
- }
- $ftp->quit; # it's ok if this fails
- return 1;
-}
-
-# If more accuracy is wanted/needed, Chris Leach sent me this patch...
-
- # > *** /install/perl/live/lib/CPAN.pm- Wed Sep 24 13:08:48 1997
- # > --- /tmp/cp Wed Sep 24 13:26:40 1997
- # > ***************
- # > *** 1562,1567 ****
- # > --- 1562,1580 ----
- # > return 1 if substr($url,0,4) eq "file";
- # > return 1 unless $url =~ m|://([^/]+)|;
- # > my $host = $1;
- # > + my $proxy = $CPAN::Config->{'http_proxy'} || $ENV{'http_proxy'};
- # > + if ($proxy) {
- # > + $proxy =~ m|://([^/:]+)|;
- # > + $proxy = $1;
- # > + my $noproxy = $CPAN::Config->{'no_proxy'} || $ENV{'no_proxy'};
- # > + if ($noproxy) {
- # > + if ($host !~ /$noproxy$/) {
- # > + $host = $proxy;
- # > + }
- # > + } else {
- # > + $host = $proxy;
- # > + }
- # > + }
- # > require Net::Ping;
- # > return 1 unless $Net::Ping::VERSION >= 2;
- # > my $p;
-
-
-#-> sub CPAN::FTP::localize ;
-sub localize {
- my($self,$file,$aslocal,$force) = @_;
- $force ||= 0;
- Carp::croak "Usage: ->localize(cpan_file,as_local_file[,$force])"
- unless defined $aslocal;
- $self->debug("file[$file] aslocal[$aslocal] force[$force]")
- if $CPAN::DEBUG;
-
- if ($^O eq 'MacOS') {
- # Comment by AK on 2000-09-03: Uniq short filenames would be
- # available in CHECKSUMS file
- my($name, $path) = File::Basename::fileparse($aslocal, '');
- if (length($name) > 31) {
- $name =~ s/(
- \.(
- readme(\.(gz|Z))? |
- (tar\.)?(gz|Z) |
- tgz |
- zip |
- pm\.(gz|Z)
- )
- )$//x;
- my $suf = $1;
- my $size = 31 - length($suf);
- while (length($name) > $size) {
- chop $name;
- }
- $name .= $suf;
- $aslocal = File::Spec->catfile($path, $name);
- }
- }
-
- if (-f $aslocal && -r _ && !($force & 1)) {
- my $size;
- if ($size = -s $aslocal) {
- $self->debug("aslocal[$aslocal]size[$size]") if $CPAN::DEBUG;
- return $aslocal;
- } else {
- # empty file from a previous unsuccessful attempt to download it
- unlink $aslocal or
- $CPAN::Frontend->mydie("Found a zero-length '$aslocal' that I ".
- "could not remove.");
- }
- }
- my($maybe_restore) = 0;
- if (-f $aslocal) {
- rename $aslocal, "$aslocal.bak$$";
- $maybe_restore++;
- }
-
- my($aslocal_dir) = File::Basename::dirname($aslocal);
- $self->mymkpath($aslocal_dir); # too early for file URLs / RT #28438
- # Inheritance is not easier to manage than a few if/else branches
- if ($CPAN::META->has_usable('LWP::UserAgent')) {
- unless ($Ua) {
- CPAN::LWP::UserAgent->config;
- eval {$Ua = CPAN::LWP::UserAgent->new;}; # Why is has_usable still not fit enough?
- if ($@) {
- $CPAN::Frontend->mywarn("CPAN::LWP::UserAgent->new dies with $@\n")
- if $CPAN::DEBUG;
- } else {
- my($var);
- $Ua->proxy('ftp', $var)
- if $var = $CPAN::Config->{ftp_proxy} || $ENV{ftp_proxy};
- $Ua->proxy('http', $var)
- if $var = $CPAN::Config->{http_proxy} || $ENV{http_proxy};
- $Ua->no_proxy($var)
- if $var = $CPAN::Config->{no_proxy} || $ENV{no_proxy};
- }
- }
- }
- for my $prx (qw(ftp_proxy http_proxy no_proxy)) {
- $ENV{$prx} = $CPAN::Config->{$prx} if $CPAN::Config->{$prx};
- }
-
- # Try the list of urls for each single object. We keep a record
- # where we did get a file from
- my(@reordered,$last);
- my $ccurllist = $self->_get_urllist;
- $last = $#$ccurllist;
- if ($force & 2) { # local cpans probably out of date, don't reorder
- @reordered = (0..$last);
- } else {
- @reordered =
- sort {
- (substr($ccurllist->[$b],0,4) eq "file")
- <=>
- (substr($ccurllist->[$a],0,4) eq "file")
- or
- defined($ThesiteURL)
- and
- ($ccurllist->[$b] eq $ThesiteURL)
- <=>
- ($ccurllist->[$a] eq $ThesiteURL)
- } 0..$last;
- }
- my(@levels);
- $Themethod ||= "";
- $self->debug("Themethod[$Themethod]reordered[@reordered]") if $CPAN::DEBUG;
- my @all_levels = (
- ["dleasy", "file"],
- ["dleasy"],
- ["dlhard"],
- ["dlhardest"],
- ["dleasy", "http","defaultsites"],
- ["dlhard", "http","defaultsites"],
- ["dleasy", "ftp", "defaultsites"],
- ["dlhard", "ftp", "defaultsites"],
- ["dlhardest","", "defaultsites"],
- );
- if ($Themethod) {
- @levels = grep {$_->[0] eq $Themethod} @all_levels;
- push @levels, grep {$_->[0] ne $Themethod} @all_levels;
- } else {
- @levels = @all_levels;
- }
- @levels = qw/dleasy/ if $^O eq 'MacOS';
- my($levelno);
- local $ENV{FTP_PASSIVE} =
- exists $CPAN::Config->{ftp_passive} ?
- $CPAN::Config->{ftp_passive} : 1;
- my $ret;
- my $stats = $self->_new_stats($file);
- LEVEL: for $levelno (0..$#levels) {
- my $level_tuple = $levels[$levelno];
- my($level,$scheme,$sitetag) = @$level_tuple;
- my $defaultsites = $sitetag && $sitetag eq "defaultsites";
- my @urllist;
- if ($defaultsites) {
- unless (defined $connect_to_internet_ok) {
- $CPAN::Frontend->myprint(sprintf qq{
-I would like to connect to one of the following sites to get '%s':
-
-%s
-},
- $file,
- join("",map { " ".$_->text."\n" } @CPAN::Defaultsites),
- );
- my $answer = CPAN::Shell::colorable_makemaker_prompt("Is it OK to try to connect to the Internet?", "yes");
- if ($answer =~ /^y/i) {
- $connect_to_internet_ok = 1;
- } else {
- $connect_to_internet_ok = 0;
- }
- }
- if ($connect_to_internet_ok) {
- @urllist = @CPAN::Defaultsites;
- } else {
- @urllist = ();
- }
- } else {
- my @host_seq = $level =~ /dleasy/ ?
- @reordered : 0..$last; # reordered has file and $Thesiteurl first
- @urllist = map { $ccurllist->[$_] } @host_seq;
- }
- $self->debug("synth. urllist[@urllist]") if $CPAN::DEBUG;
- my $aslocal_tempfile = $aslocal . ".tmp" . $$;
- if (my $recommend = $self->_recommend_url_for($file)) {
- @urllist = grep { $_ ne $recommend } @urllist;
- unshift @urllist, $recommend;
- }
- $self->debug("synth. urllist[@urllist]") if $CPAN::DEBUG;
- $ret = $self->hostdlxxx($level,$scheme,\@urllist,$file,$aslocal_tempfile,$stats);
- if ($ret) {
- CPAN->debug("ret[$ret]aslocal[$aslocal]") if $CPAN::DEBUG;
- if ($ret eq $aslocal_tempfile) {
- # if we got it exactly as we asked for, only then we
- # want to rename
- rename $aslocal_tempfile, $aslocal
- or $CPAN::Frontend->mydie("Error while trying to rename ".
- "'$ret' to '$aslocal': $!");
- $ret = $aslocal;
- }
- $Themethod = $level;
- my $now = time;
- # utime $now, $now, $aslocal; # too bad, if we do that, we
- # might alter a local mirror
- $self->debug("level[$level]") if $CPAN::DEBUG;
- last LEVEL;
- } else {
- unlink $aslocal_tempfile;
- last if $CPAN::Signal; # need to cleanup
- }
- }
- if ($ret) {
- $stats->{filesize} = -s $ret;
- }
- $self->debug("before _add_to_statistics") if $CPAN::DEBUG;
- $self->_add_to_statistics($stats);
- $self->debug("after _add_to_statistics") if $CPAN::DEBUG;
- if ($ret) {
- unlink "$aslocal.bak$$";
- return $ret;
- }
- unless ($CPAN::Signal) {
- my(@mess);
- local $" = " ";
- if (@{$CPAN::Config->{urllist}}) {
- push @mess,
- qq{Please check, if the URLs I found in your configuration file \(}.
- join(", ", @{$CPAN::Config->{urllist}}).
- qq{\) are valid.};
- } else {
- push @mess, qq{Your urllist is empty!};
- }
- push @mess, qq{The urllist can be edited.},
- qq{E.g. with 'o conf urllist push ftp://myurl/'};
- $CPAN::Frontend->mywarn(Text::Wrap::wrap("","","@mess"). "\n\n");
- $CPAN::Frontend->mywarn("Could not fetch $file\n");
- $CPAN::Frontend->mysleep(2);
- }
- if ($maybe_restore) {
- rename "$aslocal.bak$$", $aslocal;
- $CPAN::Frontend->myprint("Trying to get away with old file:\n" .
- $self->ls($aslocal));
- return $aslocal;
- }
- return;
-}
-
-sub mymkpath {
- my($self, $aslocal_dir) = @_;
- File::Path::mkpath($aslocal_dir);
- $CPAN::Frontend->mywarn(qq{Warning: You are not allowed to write into }.
- qq{directory "$aslocal_dir".
- I\'ll continue, but if you encounter problems, they may be due
- to insufficient permissions.\n}) unless -w $aslocal_dir;
-}
-
-sub hostdlxxx {
- my $self = shift;
- my $level = shift;
- my $scheme = shift;
- my $h = shift;
- $h = [ grep /^\Q$scheme\E:/, @$h ] if $scheme;
- my $method = "host$level";
- $self->$method($h, @_);
-}
-
-sub _set_attempt {
- my($self,$stats,$method,$url) = @_;
- push @{$stats->{attempts}}, {
- method => $method,
- start => _mytime,
- url => $url,
- };
-}
-
-# package CPAN::FTP;
-sub hostdleasy {
- my($self,$host_seq,$file,$aslocal,$stats) = @_;
- my($ro_url);
- HOSTEASY: for $ro_url (@$host_seq) {
- $self->_set_attempt($stats,"dleasy",$ro_url);
- my $url .= "$ro_url$file";
- $self->debug("localizing perlish[$url]") if $CPAN::DEBUG;
- if ($url =~ /^file:/) {
- my $l;
- if ($CPAN::META->has_inst('URI::URL')) {
- my $u = URI::URL->new($url);
- $l = $u->path;
- } else { # works only on Unix, is poorly constructed, but
- # hopefully better than nothing.
- # RFC 1738 says fileurl BNF is
- # fileurl = "file://" [ host | "localhost" ] "/" fpath
- # Thanks to "Mark D. Baushke" <mdb@cisco.com> for
- # the code
- ($l = $url) =~ s|^file://[^/]*/|/|; # discard the host part
- $l =~ s|^file:||; # assume they
- # meant
- # file://localhost
- $l =~ s|^/||s
- if ! -f $l && $l =~ m|^/\w:|; # e.g. /P:
- }
- $self->debug("local file[$l]") if $CPAN::DEBUG;
- if ( -f $l && -r _) {
- $ThesiteURL = $ro_url;
- return $l;
- }
- if ($l =~ /(.+)\.gz$/) {
- my $ungz = $1;
- if ( -f $ungz && -r _) {
- $ThesiteURL = $ro_url;
- return $ungz;
- }
- }
- # Maybe mirror has compressed it?
- if (-f "$l.gz") {
- $self->debug("found compressed $l.gz") if $CPAN::DEBUG;
- eval { CPAN::Tarzip->new("$l.gz")->gunzip($aslocal) };
- if ( -f $aslocal) {
- $ThesiteURL = $ro_url;
- return $aslocal;
- }
- }
- $CPAN::Frontend->mywarn("Could not find '$l'\n");
- }
- $self->debug("it was not a file URL") if $CPAN::DEBUG;
- if ($CPAN::META->has_usable('LWP')) {
- $CPAN::Frontend->myprint("Fetching with LWP:
- $url
-");
- unless ($Ua) {
- CPAN::LWP::UserAgent->config;
- eval { $Ua = CPAN::LWP::UserAgent->new; };
- if ($@) {
- $CPAN::Frontend->mywarn("CPAN::LWP::UserAgent->new dies with $@\n");
- }
- }
- my $res = $Ua->mirror($url, $aslocal);
- if ($res->is_success) {
- $ThesiteURL = $ro_url;
- my $now = time;
- utime $now, $now, $aslocal; # download time is more
- # important than upload
- # time
- return $aslocal;
- } elsif ($url !~ /\.gz(?!\n)\Z/) {
- my $gzurl = "$url.gz";
- $CPAN::Frontend->myprint("Fetching with LWP:
- $gzurl
-");
- $res = $Ua->mirror($gzurl, "$aslocal.gz");
- if ($res->is_success) {
- if (eval {CPAN::Tarzip->new("$aslocal.gz")->gunzip($aslocal)}) {
- $ThesiteURL = $ro_url;
- return $aslocal;
- }
- }
- } else {
- $CPAN::Frontend->myprint(sprintf(
- "LWP failed with code[%s] message[%s]\n",
- $res->code,
- $res->message,
- ));
- # Alan Burlison informed me that in firewall environments
- # Net::FTP can still succeed where LWP fails. So we do not
- # skip Net::FTP anymore when LWP is available.
- }
- } else {
- $CPAN::Frontend->mywarn(" LWP not available\n");
- }
- return if $CPAN::Signal;
- if ($url =~ m|^ftp://(.*?)/(.*)/(.*)|) {
- # that's the nice and easy way thanks to Graham
- $self->debug("recognized ftp") if $CPAN::DEBUG;
- my($host,$dir,$getfile) = ($1,$2,$3);
- if ($CPAN::META->has_usable('Net::FTP')) {
- $dir =~ s|/+|/|g;
- $CPAN::Frontend->myprint("Fetching with Net::FTP:
- $url
-");
- $self->debug("getfile[$getfile]dir[$dir]host[$host]" .
- "aslocal[$aslocal]") if $CPAN::DEBUG;
- if (CPAN::FTP->ftp_get($host,$dir,$getfile,$aslocal)) {
- $ThesiteURL = $ro_url;
- return $aslocal;
- }
- if ($aslocal !~ /\.gz(?!\n)\Z/) {
- my $gz = "$aslocal.gz";
- $CPAN::Frontend->myprint("Fetching with Net::FTP
- $url.gz
-");
- if (CPAN::FTP->ftp_get($host,
- $dir,
- "$getfile.gz",
- $gz) &&
- eval{CPAN::Tarzip->new($gz)->gunzip($aslocal)}
- ) {
- $ThesiteURL = $ro_url;
- return $aslocal;
- }
- }
- # next HOSTEASY;
- } else {
- CPAN->debug("Net::FTP does not count as usable atm") if $CPAN::DEBUG;
- }
- }
- if (
- UNIVERSAL::can($ro_url,"text")
- and
- $ro_url->{FROM} eq "USER"
- ) {
- ##address #17973: default URLs should not try to override
- ##user-defined URLs just because LWP is not available
- my $ret = $self->hostdlhard([$ro_url],$file,$aslocal,$stats);
- return $ret if $ret;
- }
- return if $CPAN::Signal;
- }
-}
-
-# package CPAN::FTP;
-sub hostdlhard {
- my($self,$host_seq,$file,$aslocal,$stats) = @_;
-
- # Came back if Net::FTP couldn't establish connection (or
- # failed otherwise) Maybe they are behind a firewall, but they
- # gave us a socksified (or other) ftp program...
-
- my($ro_url);
- my($devnull) = $CPAN::Config->{devnull} || "";
- # < /dev/null ";
- my($aslocal_dir) = File::Basename::dirname($aslocal);
- File::Path::mkpath($aslocal_dir);
- HOSTHARD: for $ro_url (@$host_seq) {
- $self->_set_attempt($stats,"dlhard",$ro_url);
- my $url = "$ro_url$file";
- my($proto,$host,$dir,$getfile);
-
- # Courtesy Mark Conty mark_conty@cargill.com change from
- # if ($url =~ m|^ftp://(.*?)/(.*)/(.*)|) {
- # to
- if ($url =~ m|^([^:]+)://(.*?)/(.*)/(.*)|) {
- # proto not yet used
- ($proto,$host,$dir,$getfile) = ($1,$2,$3,$4);
- } else {
- next HOSTHARD; # who said, we could ftp anything except ftp?
- }
- next HOSTHARD if $proto eq "file"; # file URLs would have had
- # success above. Likely a bogus URL
-
- $self->debug("localizing funkyftpwise[$url]") if $CPAN::DEBUG;
-
- # Try the most capable first and leave ncftp* for last as it only
- # does FTP.
- DLPRG: for my $f (qw(curl wget lynx ncftpget ncftp)) {
- my $funkyftp = CPAN::HandleConfig->safe_quote($CPAN::Config->{$f});
- next unless defined $funkyftp;
- next if $funkyftp =~ /^\s*$/;
-
- my($asl_ungz, $asl_gz);
- ($asl_ungz = $aslocal) =~ s/\.gz//;
- $asl_gz = "$asl_ungz.gz";
-
- my($src_switch) = "";
- my($chdir) = "";
- my($stdout_redir) = " > $asl_ungz";
- if ($f eq "lynx") {
- $src_switch = " -source";
- } elsif ($f eq "ncftp") {
- $src_switch = " -c";
- } elsif ($f eq "wget") {
- $src_switch = " -O $asl_ungz";
- $stdout_redir = "";
- } elsif ($f eq 'curl') {
- $src_switch = ' -L -f -s -S --netrc-optional';
- }
-
- if ($f eq "ncftpget") {
- $chdir = "cd $aslocal_dir && ";
- $stdout_redir = "";
- }
- $CPAN::Frontend->myprint(
- qq[
-Trying with "$funkyftp$src_switch" to get
- $url
-]);
- my($system) =
- "$chdir$funkyftp$src_switch \"$url\" $devnull$stdout_redir";
- $self->debug("system[$system]") if $CPAN::DEBUG;
- my($wstatus) = system($system);
- if ($f eq "lynx") {
- # lynx returns 0 when it fails somewhere
- if (-s $asl_ungz) {
- my $content = do { local *FH;
- open FH, $asl_ungz or die;
- local $/;
- <FH> };
- if ($content =~ /^<.*(<title>[45]|Error [45])/si) {
- $CPAN::Frontend->mywarn(qq{
-No success, the file that lynx has downloaded looks like an error message:
-$content
-});
- $CPAN::Frontend->mysleep(1);
- next DLPRG;
- }
- } else {
- $CPAN::Frontend->myprint(qq{
-No success, the file that lynx has downloaded is an empty file.
-});
- next DLPRG;
- }
- }
- if ($wstatus == 0) {
- if (-s $aslocal) {
- # Looks good
- } elsif ($asl_ungz ne $aslocal) {
- # test gzip integrity
- if (eval{CPAN::Tarzip->new($asl_ungz)->gtest}) {
- # e.g. foo.tar is gzipped --> foo.tar.gz
- rename $asl_ungz, $aslocal;
- } else {
- eval{CPAN::Tarzip->new($asl_gz)->gzip($asl_ungz)};
- }
- }
- $ThesiteURL = $ro_url;
- return $aslocal;
- } elsif ($url !~ /\.gz(?!\n)\Z/) {
- unlink $asl_ungz if
- -f $asl_ungz && -s _ == 0;
- my $gz = "$aslocal.gz";
- my $gzurl = "$url.gz";
- $CPAN::Frontend->myprint(
- qq[
- Trying with "$funkyftp$src_switch" to get
- $url.gz
- ]);
- my($system) = "$funkyftp$src_switch \"$url.gz\" $devnull > $asl_gz";
- $self->debug("system[$system]") if $CPAN::DEBUG;
- my($wstatus);
- if (($wstatus = system($system)) == 0
- &&
- -s $asl_gz
- ) {
- # test gzip integrity
- my $ct = eval{CPAN::Tarzip->new($asl_gz)};
- if ($ct && $ct->gtest) {
- $ct->gunzip($aslocal);
- } else {
- # somebody uncompressed file for us?
- rename $asl_ungz, $aslocal;
- }
- $ThesiteURL = $ro_url;
- return $aslocal;
- } else {
- unlink $asl_gz if -f $asl_gz;
- }
- } else {
- my $estatus = $wstatus >> 8;
- my $size = -f $aslocal ?
- ", left\n$aslocal with size ".-s _ :
- "\nWarning: expected file [$aslocal] doesn't exist";
- $CPAN::Frontend->myprint(qq{
- System call "$system"
- returned status $estatus (wstat $wstatus)$size
- });
- }
- return if $CPAN::Signal;
- } # transfer programs
- } # host
-}
-
-# package CPAN::FTP;
-sub hostdlhardest {
- my($self,$host_seq,$file,$aslocal,$stats) = @_;
-
- return unless @$host_seq;
- my($ro_url);
- my($aslocal_dir) = File::Basename::dirname($aslocal);
- File::Path::mkpath($aslocal_dir);
- my $ftpbin = $CPAN::Config->{ftp};
- unless ($ftpbin && length $ftpbin && MM->maybe_command($ftpbin)) {
- $CPAN::Frontend->myprint("No external ftp command available\n\n");
- return;
- }
- $CPAN::Frontend->mywarn(qq{
-As a last ressort we now switch to the external ftp command '$ftpbin'
-to get '$aslocal'.
-
-Doing so often leads to problems that are hard to diagnose.
-
-If you're victim of such problems, please consider unsetting the ftp
-config variable with
-
- o conf ftp ""
- o conf commit
-
-});
- $CPAN::Frontend->mysleep(2);
- HOSTHARDEST: for $ro_url (@$host_seq) {
- $self->_set_attempt($stats,"dlhardest",$ro_url);
- my $url = "$ro_url$file";
- $self->debug("localizing ftpwise[$url]") if $CPAN::DEBUG;
- unless ($url =~ m|^ftp://(.*?)/(.*)/(.*)|) {
- next;
- }
- my($host,$dir,$getfile) = ($1,$2,$3);
- my $timestamp = 0;
- my($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,
- $ctime,$blksize,$blocks) = stat($aslocal);
- $timestamp = $mtime ||= 0;
- my($netrc) = CPAN::FTP::netrc->new;
- my($netrcfile) = $netrc->netrc;
- my($verbose) = $CPAN::DEBUG{'FTP'} & $CPAN::DEBUG ? " -v" : "";
- my $targetfile = File::Basename::basename($aslocal);
- my(@dialog);
- push(
- @dialog,
- "lcd $aslocal_dir",
- "cd /",
- map("cd $_", split /\//, $dir), # RFC 1738
- "bin",
- "get $getfile $targetfile",
- "quit"
- );
- if (! $netrcfile) {
- CPAN->debug("No ~/.netrc file found") if $CPAN::DEBUG;
- } elsif ($netrc->hasdefault || $netrc->contains($host)) {
- CPAN->debug(sprintf("hasdef[%d]cont($host)[%d]",
- $netrc->hasdefault,
- $netrc->contains($host))) if $CPAN::DEBUG;
- if ($netrc->protected) {
- my $dialog = join "", map { " $_\n" } @dialog;
- my $netrc_explain;
- if ($netrc->contains($host)) {
- $netrc_explain = "Relying that your .netrc entry for '$host' ".
- "manages the login";
- } else {
- $netrc_explain = "Relying that your default .netrc entry ".
- "manages the login";
- }
- $CPAN::Frontend->myprint(qq{
- Trying with external ftp to get
- $url
- $netrc_explain
- Going to send the dialog
-$dialog
-}
- );
- $self->talk_ftp("$ftpbin$verbose $host",
- @dialog);
- ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
- $atime,$mtime,$ctime,$blksize,$blocks) = stat($aslocal);
- $mtime ||= 0;
- if ($mtime > $timestamp) {
- $CPAN::Frontend->myprint("GOT $aslocal\n");
- $ThesiteURL = $ro_url;
- return $aslocal;
- } else {
- $CPAN::Frontend->myprint("Hmm... Still failed!\n");
- }
- return if $CPAN::Signal;
- } else {
- $CPAN::Frontend->mywarn(qq{Your $netrcfile is not }.
- qq{correctly protected.\n});
- }
- } else {
- $CPAN::Frontend->mywarn("Your ~/.netrc neither contains $host
- nor does it have a default entry\n");
- }
-
- # OK, they don't have a valid ~/.netrc. Use 'ftp -n'
- # then and login manually to host, using e-mail as
- # password.
- $CPAN::Frontend->myprint(qq{Issuing "$ftpbin$verbose -n"\n});
- unshift(
- @dialog,
- "open $host",
- "user anonymous $Config::Config{'cf_email'}"
- );
- my $dialog = join "", map { " $_\n" } @dialog;
- $CPAN::Frontend->myprint(qq{
- Trying with external ftp to get
- $url
- Going to send the dialog
-$dialog
-}
- );
- $self->talk_ftp("$ftpbin$verbose -n", @dialog);
- ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
- $atime,$mtime,$ctime,$blksize,$blocks) = stat($aslocal);
- $mtime ||= 0;
- if ($mtime > $timestamp) {
- $CPAN::Frontend->myprint("GOT $aslocal\n");
- $ThesiteURL = $ro_url;
- return $aslocal;
- } else {
- $CPAN::Frontend->myprint("Bad luck... Still failed!\n");
- }
- return if $CPAN::Signal;
- $CPAN::Frontend->mywarn("Can't access URL $url.\n\n");
- $CPAN::Frontend->mysleep(2);
- } # host
-}
-
-# package CPAN::FTP;
-sub talk_ftp {
- my($self,$command,@dialog) = @_;
- my $fh = FileHandle->new;
- $fh->open("|$command") or die "Couldn't open ftp: $!";
- foreach (@dialog) { $fh->print("$_\n") }
- $fh->close; # Wait for process to complete
- my $wstatus = $?;
- my $estatus = $wstatus >> 8;
- $CPAN::Frontend->myprint(qq{
-Subprocess "|$command"
- returned status $estatus (wstat $wstatus)
-}) if $wstatus;
-}
-
-# find2perl needs modularization, too, all the following is stolen
-# from there
-# CPAN::FTP::ls
-sub ls {
- my($self,$name) = @_;
- my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$sizemm,
- $atime,$mtime,$ctime,$blksize,$blocks) = lstat($name);
-
- my($perms,%user,%group);
- my $pname = $name;
-
- if ($blocks) {
- $blocks = int(($blocks + 1) / 2);
- }
- else {
- $blocks = int(($sizemm + 1023) / 1024);
- }
-
- if (-f _) { $perms = '-'; }
- elsif (-d _) { $perms = 'd'; }
- elsif (-c _) { $perms = 'c'; $sizemm = &sizemm; }
- elsif (-b _) { $perms = 'b'; $sizemm = &sizemm; }
- elsif (-p _) { $perms = 'p'; }
- elsif (-S _) { $perms = 's'; }
- else { $perms = 'l'; $pname .= ' -> ' . readlink($_); }
-
- my(@rwx) = ('---','--x','-w-','-wx','r--','r-x','rw-','rwx');
- my(@moname) = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
- my $tmpmode = $mode;
- my $tmp = $rwx[$tmpmode & 7];
- $tmpmode >>= 3;
- $tmp = $rwx[$tmpmode & 7] . $tmp;
- $tmpmode >>= 3;
- $tmp = $rwx[$tmpmode & 7] . $tmp;
- substr($tmp,2,1) =~ tr/-x/Ss/ if -u _;
- substr($tmp,5,1) =~ tr/-x/Ss/ if -g _;
- substr($tmp,8,1) =~ tr/-x/Tt/ if -k _;
- $perms .= $tmp;
-
- my $user = $user{$uid} || $uid; # too lazy to implement lookup
- my $group = $group{$gid} || $gid;
-
- my($sec,$min,$hour,$mday,$mon,$year) = localtime($mtime);
- my($timeyear);
- my($moname) = $moname[$mon];
- if (-M _ > 365.25 / 2) {
- $timeyear = $year + 1900;
- }
- else {
- $timeyear = sprintf("%02d:%02d", $hour, $min);
- }
-
- sprintf "%5lu %4ld %-10s %2d %-8s %-8s %8s %s %2d %5s %s\n",
- $ino,
- $blocks,
- $perms,
- $nlink,
- $user,
- $group,
- $sizemm,
- $moname,
- $mday,
- $timeyear,
- $pname;
-}
-
-package CPAN::FTP::netrc;
-use strict;
-
-# package CPAN::FTP::netrc;
-sub new {
- my($class) = @_;
- my $home = CPAN::HandleConfig::home;
- my $file = File::Spec->catfile($home,".netrc");
-
- my($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
- $atime,$mtime,$ctime,$blksize,$blocks)
- = stat($file);
- $mode ||= 0;
- my $protected = 0;
-
- my($fh,@machines,$hasdefault);
- $hasdefault = 0;
- $fh = FileHandle->new or die "Could not create a filehandle";
-
- if($fh->open($file)) {
- $protected = ($mode & 077) == 0;
- local($/) = "";
- NETRC: while (<$fh>) {
- my(@tokens) = split " ", $_;
- TOKEN: while (@tokens) {
- my($t) = shift @tokens;
- if ($t eq "default") {
- $hasdefault++;
- last NETRC;
- }
- last TOKEN if $t eq "macdef";
- if ($t eq "machine") {
- push @machines, shift @tokens;
- }
- }
- }
- } else {
- $file = $hasdefault = $protected = "";
- }
-
- bless {
- 'mach' => [@machines],
- 'netrc' => $file,
- 'hasdefault' => $hasdefault,
- 'protected' => $protected,
- }, $class;
-}
-
-# CPAN::FTP::netrc::hasdefault;
-sub hasdefault { shift->{'hasdefault'} }
-sub netrc { shift->{'netrc'} }
-sub protected { shift->{'protected'} }
-sub contains {
- my($self,$mach) = @_;
- for ( @{$self->{'mach'}} ) {
- return 1 if $_ eq $mach;
- }
- return 0;
-}
-
-package CPAN::Complete;
-use strict;
-
-sub gnu_cpl {
- my($text, $line, $start, $end) = @_;
- my(@perlret) = cpl($text, $line, $start);
- # find longest common match. Can anybody show me how to peruse
- # T::R::Gnu to have this done automatically? Seems expensive.
- return () unless @perlret;
- my($newtext) = $text;
- for (my $i = length($text)+1;;$i++) {
- last unless length($perlret[0]) && length($perlret[0]) >= $i;
- my $try = substr($perlret[0],0,$i);
- my @tries = grep {substr($_,0,$i) eq $try} @perlret;
- # warn "try[$try]tries[@tries]";
- if (@tries == @perlret) {
- $newtext = $try;
- } else {
- last;
- }
- }
- ($newtext,@perlret);
-}
-
-#-> sub CPAN::Complete::cpl ;
-sub cpl {
- my($word,$line,$pos) = @_;
- $word ||= "";
- $line ||= "";
- $pos ||= 0;
- CPAN->debug("word [$word] line[$line] pos[$pos]") if $CPAN::DEBUG;
- $line =~ s/^\s*//;
- if ($line =~ s/^((?:notest|f?force)\s*)//) {
- $pos -= length($1);
- }
- my @return;
- if ($pos == 0 || $line =~ /^(?:h(?:elp)?|\?)\s/) {
- @return = grep /^\Q$word\E/, @CPAN::Complete::COMMANDS;
- } elsif ( $line !~ /^[\!abcdghimorutl]/ ) {
- @return = ();
- } elsif ($line =~ /^(a|ls)\s/) {
- @return = cplx('CPAN::Author',uc($word));
- } elsif ($line =~ /^b\s/) {
- CPAN::Shell->local_bundles;
- @return = cplx('CPAN::Bundle',$word);
- } elsif ($line =~ /^d\s/) {
- @return = cplx('CPAN::Distribution',$word);
- } elsif ($line =~ m/^(
- [mru]|make|clean|dump|get|test|install|readme|look|cvs_import|perldoc|recent
- )\s/x ) {
- if ($word =~ /^Bundle::/) {
- CPAN::Shell->local_bundles;
- }
- @return = (cplx('CPAN::Module',$word),cplx('CPAN::Bundle',$word));
- } elsif ($line =~ /^i\s/) {
- @return = cpl_any($word);
- } elsif ($line =~ /^reload\s/) {
- @return = cpl_reload($word,$line,$pos);
- } elsif ($line =~ /^o\s/) {
- @return = cpl_option($word,$line,$pos);
- } elsif ($line =~ m/^\S+\s/ ) {
- # fallback for future commands and what we have forgotten above
- @return = (cplx('CPAN::Module',$word),cplx('CPAN::Bundle',$word));
- } else {
- @return = ();
- }
- return @return;
-}
-
-#-> sub CPAN::Complete::cplx ;
-sub cplx {
- my($class, $word) = @_;
- if (CPAN::_sqlite_running) {
- $CPAN::SQLite->search($class, "^\Q$word\E");
- }
- sort grep /^\Q$word\E/, map { $_->id } $CPAN::META->all_objects($class);
-}
-
-#-> sub CPAN::Complete::cpl_any ;
-sub cpl_any {
- my($word) = shift;
- return (
- cplx('CPAN::Author',$word),
- cplx('CPAN::Bundle',$word),
- cplx('CPAN::Distribution',$word),
- cplx('CPAN::Module',$word),
- );
-}
-
-#-> sub CPAN::Complete::cpl_reload ;
-sub cpl_reload {
- my($word,$line,$pos) = @_;
- $word ||= "";
- my(@words) = split " ", $line;
- CPAN->debug("word[$word] line[$line] pos[$pos]") if $CPAN::DEBUG;
- my(@ok) = qw(cpan index);
- return @ok if @words == 1;
- return grep /^\Q$word\E/, @ok if @words == 2 && $word;
-}
-
-#-> sub CPAN::Complete::cpl_option ;
-sub cpl_option {
- my($word,$line,$pos) = @_;
- $word ||= "";
- my(@words) = split " ", $line;
- CPAN->debug("word[$word] line[$line] pos[$pos]") if $CPAN::DEBUG;
- my(@ok) = qw(conf debug);
- return @ok if @words == 1;
- return grep /^\Q$word\E/, @ok if @words == 2 && length($word);
- if (0) {
- } elsif ($words[1] eq 'index') {
- return ();
- } elsif ($words[1] eq 'conf') {
- return CPAN::HandleConfig::cpl(@_);
- } elsif ($words[1] eq 'debug') {
- return sort grep /^\Q$word\E/i,
- sort keys %CPAN::DEBUG, 'all';
- }
-}
-
-package CPAN::Index;
-use strict;
-
-#-> sub CPAN::Index::force_reload ;
-sub force_reload {
- my($class) = @_;
- $CPAN::Index::LAST_TIME = 0;
- $class->reload(1);
-}
-
-#-> sub CPAN::Index::reload ;
-sub reload {
- my($self,$force) = @_;
- my $time = time;
-
- # XXX check if a newer one is available. (We currently read it
- # from time to time)
- for ($CPAN::Config->{index_expire}) {
- $_ = 0.001 unless $_ && $_ > 0.001;
- }
- unless (1 || $CPAN::Have_warned->{readmetadatacache}++) {
- # debug here when CPAN doesn't seem to read the Metadata
- require Carp;
- Carp::cluck("META-PROTOCOL[$CPAN::META->{PROTOCOL}]");
- }
- unless ($CPAN::META->{PROTOCOL}) {
- $self->read_metadata_cache;
- $CPAN::META->{PROTOCOL} ||= "1.0";
- }
- if ( $CPAN::META->{PROTOCOL} < PROTOCOL ) {
- # warn "Setting last_time to 0";
- $LAST_TIME = 0; # No warning necessary
- }
- if ($LAST_TIME + $CPAN::Config->{index_expire}*86400 > $time
- and ! $force) {
- # called too often
- # CPAN->debug("LAST_TIME[$LAST_TIME]index_expire[$CPAN::Config->{index_expire}]time[$time]");
- } elsif (0) {
- # IFF we are developing, it helps to wipe out the memory
- # between reloads, otherwise it is not what a user expects.
- undef $CPAN::META; # Neue Gruendlichkeit since v1.52(r1.274)
- $CPAN::META = CPAN->new;
- } else {
- my($debug,$t2);
- local $LAST_TIME = $time;
- local $CPAN::META->{PROTOCOL} = PROTOCOL;
-
- my $needshort = $^O eq "dos";
-
- $self->rd_authindex($self
- ->reload_x(
- "authors/01mailrc.txt.gz",
- $needshort ?
- File::Spec->catfile('authors', '01mailrc.gz') :
- File::Spec->catfile('authors', '01mailrc.txt.gz'),
- $force));
- $t2 = time;
- $debug = "timing reading 01[".($t2 - $time)."]";
- $time = $t2;
- return if $CPAN::Signal; # this is sometimes lengthy
- $self->rd_modpacks($self
- ->reload_x(
- "modules/02packages.details.txt.gz",
- $needshort ?
- File::Spec->catfile('modules', '02packag.gz') :
- File::Spec->catfile('modules', '02packages.details.txt.gz'),
- $force));
- $t2 = time;
- $debug .= "02[".($t2 - $time)."]";
- $time = $t2;
- return if $CPAN::Signal; # this is sometimes lengthy
- $self->rd_modlist($self
- ->reload_x(
- "modules/03modlist.data.gz",
- $needshort ?
- File::Spec->catfile('modules', '03mlist.gz') :
- File::Spec->catfile('modules', '03modlist.data.gz'),
- $force));
- $self->write_metadata_cache;
- $t2 = time;
- $debug .= "03[".($t2 - $time)."]";
- $time = $t2;
- CPAN->debug($debug) if $CPAN::DEBUG;
- }
- if ($CPAN::Config->{build_dir_reuse}) {
- $self->reanimate_build_dir;
- }
- if (CPAN::_sqlite_running) {
- $CPAN::SQLite->reload(time => $time, force => $force)
- if not $LAST_TIME;
- }
- $LAST_TIME = $time;
- $CPAN::META->{PROTOCOL} = PROTOCOL;
-}
-
-#-> sub CPAN::Index::reanimate_build_dir ;
-sub reanimate_build_dir {
- my($self) = @_;
- unless ($CPAN::META->has_inst($CPAN::Config->{yaml_module}||"YAML")) {
- return;
- }
- return if $HAVE_REANIMATED++;
- my $d = $CPAN::Config->{build_dir};
- my $dh = DirHandle->new;
- opendir $dh, $d or return; # does not exist
- my $dirent;
- my $i = 0;
- my $painted = 0;
- my $restored = 0;
- $CPAN::Frontend->myprint("Going to read $CPAN::Config->{build_dir}/\n");
- my @candidates = map { $_->[0] }
- sort { $b->[1] <=> $a->[1] }
- map { [ $_, -M File::Spec->catfile($d,$_) ] }
- grep {/\.yml$/} readdir $dh;
- DISTRO: for $i (0..$#candidates) {
- my $dirent = $candidates[$i];
- my $y = eval {CPAN->_yaml_loadfile(File::Spec->catfile($d,$dirent))};
- if ($@) {
- warn "Error while parsing file '$dirent'; error: '$@'";
- next DISTRO;
- }
- my $c = $y->[0];
- if ($c && CPAN->_perl_fingerprint($c->{perl})) {
- my $key = $c->{distribution}{ID};
- for my $k (keys %{$c->{distribution}}) {
- if ($c->{distribution}{$k}
- && ref $c->{distribution}{$k}
- && UNIVERSAL::isa($c->{distribution}{$k},"CPAN::Distrostatus")) {
- $c->{distribution}{$k}{COMMANDID} = $i - @candidates;
- }
- }
-
- #we tried to restore only if element already
- #exists; but then we do not work with metadata
- #turned off.
- my $do
- = $CPAN::META->{readwrite}{'CPAN::Distribution'}{$key}
- = $c->{distribution};
- for my $skipper (qw(
- badtestcnt
- configure_requires_later
- configure_requires_later_for
- force_update
- later
- later_for
- notest
- should_report
- sponsored_mods
- )) {
- delete $do->{$skipper};
- }
- # $DB::single = 1;
- if ($do->{make_test}
- && $do->{build_dir}
- && !(UNIVERSAL::can($do->{make_test},"failed") ?
- $do->{make_test}->failed :
- $do->{make_test} =~ /^YES/
- )
- && (
- !$do->{install}
- ||
- $do->{install}->failed
- )
- ) {
- $CPAN::META->is_tested($do->{build_dir},$do->{make_test}{TIME});
- }
- $restored++;
- }
- $i++;
- while (($painted/76) < ($i/@candidates)) {
- $CPAN::Frontend->myprint(".");
- $painted++;
- }
- }
- $CPAN::Frontend->myprint(sprintf(
- "DONE\nFound %s old build%s, restored the state of %s\n",
- @candidates ? sprintf("%d",scalar @candidates) : "no",
- @candidates==1 ? "" : "s",
- $restored || "none",
- ));
-}
-
-
-#-> sub CPAN::Index::reload_x ;
-sub reload_x {
- my($cl,$wanted,$localname,$force) = @_;
- $force |= 2; # means we're dealing with an index here
- CPAN::HandleConfig->load; # we should guarantee loading wherever
- # we rely on Config XXX
- $localname ||= $wanted;
- my $abs_wanted = File::Spec->catfile($CPAN::Config->{'keep_source_where'},
- $localname);
- if (
- -f $abs_wanted &&
- -M $abs_wanted < $CPAN::Config->{'index_expire'} &&
- !($force & 1)
- ) {
- my $s = $CPAN::Config->{'index_expire'} == 1 ? "" : "s";
- $cl->debug(qq{$abs_wanted younger than $CPAN::Config->{'index_expire'} }.
- qq{day$s. I\'ll use that.});
- return $abs_wanted;
- } else {
- $force |= 1; # means we're quite serious about it.
- }
- return CPAN::FTP->localize($wanted,$abs_wanted,$force);
-}
-
-#-> sub CPAN::Index::rd_authindex ;
-sub rd_authindex {
- my($cl, $index_target) = @_;
- return unless defined $index_target;
- return if CPAN::_sqlite_running;
- my @lines;
- $CPAN::Frontend->myprint("Going to read $index_target\n");
- local(*FH);
- tie *FH, 'CPAN::Tarzip', $index_target;
- local($/) = "\n";
- local($_);
- push @lines, split /\012/ while <FH>;
- my $i = 0;
- my $painted = 0;
- foreach (@lines) {
- my($userid,$fullname,$email) =
- m/alias\s+(\S+)\s+\"([^\"\<]*)\s+\<(.*)\>\"/;
- $fullname ||= $email;
- if ($userid && $fullname && $email) {
- my $userobj = $CPAN::META->instance('CPAN::Author',$userid);
- $userobj->set('FULLNAME' => $fullname, 'EMAIL' => $email);
- } else {
- CPAN->debug(sprintf "line[%s]", $_) if $CPAN::DEBUG;
- }
- $i++;
- while (($painted/76) < ($i/@lines)) {
- $CPAN::Frontend->myprint(".");
- $painted++;
- }
- return if $CPAN::Signal;
- }
- $CPAN::Frontend->myprint("DONE\n");
-}
-
-sub userid {
- my($self,$dist) = @_;
- $dist = $self->{'id'} unless defined $dist;
- my($ret) = $dist =~ m|(?:\w/\w\w/)?([^/]+)/|;
- $ret;
-}
-
-#-> sub CPAN::Index::rd_modpacks ;
-sub rd_modpacks {
- my($self, $index_target) = @_;
- return unless defined $index_target;
- return if CPAN::_sqlite_running;
- $CPAN::Frontend->myprint("Going to read $index_target\n");
- my $fh = CPAN::Tarzip->TIEHANDLE($index_target);
- local $_;
- CPAN->debug(sprintf "start[%d]", time) if $CPAN::DEBUG;
- my $slurp = "";
- my $chunk;
- while (my $bytes = $fh->READ(\$chunk,8192)) {
- $slurp.=$chunk;
- }
- my @lines = split /\012/, $slurp;
- CPAN->debug(sprintf "end[%d]", time) if $CPAN::DEBUG;
- undef $fh;
- # read header
- my($line_count,$last_updated);
- while (@lines) {
- my $shift = shift(@lines);
- last if $shift =~ /^\s*$/;
- $shift =~ /^Line-Count:\s+(\d+)/ and $line_count = $1;
- $shift =~ /^Last-Updated:\s+(.+)/ and $last_updated = $1;
- }
- CPAN->debug("line_count[$line_count]last_updated[$last_updated]") if $CPAN::DEBUG;
- if (not defined $line_count) {
-
- $CPAN::Frontend->mywarn(qq{Warning: Your $index_target does not contain a Line-Count header.
-Please check the validity of the index file by comparing it to more
-than one CPAN mirror. I'll continue but problems seem likely to
-happen.\a
-});
-
- $CPAN::Frontend->mysleep(5);
- } elsif ($line_count != scalar @lines) {
-
- $CPAN::Frontend->mywarn(sprintf qq{Warning: Your %s
-contains a Line-Count header of %d but I see %d lines there. Please
-check the validity of the index file by comparing it to more than one
-CPAN mirror. I'll continue but problems seem likely to happen.\a\n},
-$index_target, $line_count, scalar(@lines));
-
- }
- if (not defined $last_updated) {
-
- $CPAN::Frontend->mywarn(qq{Warning: Your $index_target does not contain a Last-Updated header.
-Please check the validity of the index file by comparing it to more
-than one CPAN mirror. I'll continue but problems seem likely to
-happen.\a
-});
-
- $CPAN::Frontend->mysleep(5);
- } else {
-
- $CPAN::Frontend
- ->myprint(sprintf qq{ Database was generated on %s\n},
- $last_updated);
- $DATE_OF_02 = $last_updated;
-
- my $age = time;
- if ($CPAN::META->has_inst('HTTP::Date')) {
- require HTTP::Date;
- $age -= HTTP::Date::str2time($last_updated);
- } else {
- $CPAN::Frontend->mywarn(" HTTP::Date not available\n");
- require Time::Local;
- my(@d) = $last_updated =~ / (\d+) (\w+) (\d+) (\d+):(\d+):(\d+) /;
- $d[1] = index("Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec", $d[1])/4;
- $age -= $d[1]>=0 ? Time::Local::timegm(@d[5,4,3,0,1,2]) : 0;
- }
- $age /= 3600*24;
- if ($age > 30) {
-
- $CPAN::Frontend
- ->mywarn(sprintf
- qq{Warning: This index file is %d days old.
- Please check the host you chose as your CPAN mirror for staleness.
- I'll continue but problems seem likely to happen.\a\n},
- $age);
-
- } elsif ($age < -1) {
-
- $CPAN::Frontend
- ->mywarn(sprintf
- qq{Warning: Your system date is %d days behind this index file!
- System time: %s
- Timestamp index file: %s
- Please fix your system time, problems with the make command expected.\n},
- -$age,
- scalar gmtime,
- $DATE_OF_02,
- );
-
- }
- }
-
-
- # A necessity since we have metadata_cache: delete what isn't
- # there anymore
- my $secondtime = $CPAN::META->exists("CPAN::Module","CPAN");
- CPAN->debug("secondtime[$secondtime]") if $CPAN::DEBUG;
- my(%exists);
- my $i = 0;
- my $painted = 0;
- foreach (@lines) {
- # before 1.56 we split into 3 and discarded the rest. From
- # 1.57 we assign remaining text to $comment thus allowing to
- # influence isa_perl
- my($mod,$version,$dist,$comment) = split " ", $_, 4;
- my($bundle,$id,$userid);
-
- if ($mod eq 'CPAN' &&
- ! (
- CPAN::Queue->exists('Bundle::CPAN') ||
- CPAN::Queue->exists('CPAN')
- )
- ) {
- local($^W)= 0;
- if ($version > $CPAN::VERSION) {
- $CPAN::Frontend->mywarn(qq{
- New CPAN.pm version (v$version) available.
- [Currently running version is v$CPAN::VERSION]
- You might want to try
- install CPAN
- reload cpan
- to both upgrade CPAN.pm and run the new version without leaving
- the current session.
-
-}); #});
- $CPAN::Frontend->mysleep(2);
- $CPAN::Frontend->myprint(qq{\n});
- }
- last if $CPAN::Signal;
- } elsif ($mod =~ /^Bundle::(.*)/) {
- $bundle = $1;
- }
-
- if ($bundle) {
- $id = $CPAN::META->instance('CPAN::Bundle',$mod);
- # Let's make it a module too, because bundles have so much
- # in common with modules.
-
- # Changed in 1.57_63: seems like memory bloat now without
- # any value, so commented out
-
- # $CPAN::META->instance('CPAN::Module',$mod);
-
- } else {
-
- # instantiate a module object
- $id = $CPAN::META->instance('CPAN::Module',$mod);
-
- }
-
- # Although CPAN prohibits same name with different version the
- # indexer may have changed the version for the same distro
- # since the last time ("Force Reindexing" feature)
- if ($id->cpan_file ne $dist
- ||
- $id->cpan_version ne $version
- ) {
- $userid = $id->userid || $self->userid($dist);
- $id->set(
- 'CPAN_USERID' => $userid,
- 'CPAN_VERSION' => $version,
- 'CPAN_FILE' => $dist,
- );
- }
-
- # instantiate a distribution object
- if ($CPAN::META->exists('CPAN::Distribution',$dist)) {
- # we do not need CONTAINSMODS unless we do something with
- # this dist, so we better produce it on demand.
-
- ## my $obj = $CPAN::META->instance(
- ## 'CPAN::Distribution' => $dist
- ## );
- ## $obj->{CONTAINSMODS}{$mod} = undef; # experimental
- } else {
- $CPAN::META->instance(
- 'CPAN::Distribution' => $dist
- )->set(
- 'CPAN_USERID' => $userid,
- 'CPAN_COMMENT' => $comment,
- );
- }
- if ($secondtime) {
- for my $name ($mod,$dist) {
- # $self->debug("exists name[$name]") if $CPAN::DEBUG;
- $exists{$name} = undef;
- }
- }
- $i++;
- while (($painted/76) < ($i/@lines)) {
- $CPAN::Frontend->myprint(".");
- $painted++;
- }
- return if $CPAN::Signal;
- }
- $CPAN::Frontend->myprint("DONE\n");
- if ($secondtime) {
- for my $class (qw(CPAN::Module CPAN::Bundle CPAN::Distribution)) {
- for my $o ($CPAN::META->all_objects($class)) {
- next if exists $exists{$o->{ID}};
- $CPAN::META->delete($class,$o->{ID});
- # CPAN->debug("deleting ID[$o->{ID}] in class[$class]")
- # if $CPAN::DEBUG;
- }
- }
- }
-}
-
-#-> sub CPAN::Index::rd_modlist ;
-sub rd_modlist {
- my($cl,$index_target) = @_;
- return unless defined $index_target;
- return if CPAN::_sqlite_running;
- $CPAN::Frontend->myprint("Going to read $index_target\n");
- my $fh = CPAN::Tarzip->TIEHANDLE($index_target);
- local $_;
- my $slurp = "";
- my $chunk;
- while (my $bytes = $fh->READ(\$chunk,8192)) {
- $slurp.=$chunk;
- }
- my @eval2 = split /\012/, $slurp;
-
- while (@eval2) {
- my $shift = shift(@eval2);
- if ($shift =~ /^Date:\s+(.*)/) {
- if ($DATE_OF_03 eq $1) {
- $CPAN::Frontend->myprint("Unchanged.\n");
- return;
- }
- ($DATE_OF_03) = $1;
- }
- last if $shift =~ /^\s*$/;
- }
- push @eval2, q{CPAN::Modulelist->data;};
- local($^W) = 0;
- my($comp) = Safe->new("CPAN::Safe1");
- my($eval2) = join("\n", @eval2);
- CPAN->debug(sprintf "length of eval2[%d]", length $eval2) if $CPAN::DEBUG;
- my $ret = $comp->reval($eval2);
- Carp::confess($@) if $@;
- return if $CPAN::Signal;
- my $i = 0;
- my $until = keys(%$ret);
- my $painted = 0;
- CPAN->debug(sprintf "until[%d]", $until) if $CPAN::DEBUG;
- for (keys %$ret) {
- my $obj = $CPAN::META->instance("CPAN::Module",$_);
- delete $ret->{$_}{modid}; # not needed here, maybe elsewhere
- $obj->set(%{$ret->{$_}});
- $i++;
- while (($painted/76) < ($i/$until)) {
- $CPAN::Frontend->myprint(".");
- $painted++;
- }
- return if $CPAN::Signal;
- }
- $CPAN::Frontend->myprint("DONE\n");
-}
-
-#-> sub CPAN::Index::write_metadata_cache ;
-sub write_metadata_cache {
- my($self) = @_;
- return unless $CPAN::Config->{'cache_metadata'};
- return if CPAN::_sqlite_running;
- return unless $CPAN::META->has_usable("Storable");
- my $cache;
- foreach my $k (qw(CPAN::Bundle CPAN::Author CPAN::Module
- CPAN::Distribution)) {
- $cache->{$k} = $CPAN::META->{readonly}{$k}; # unsafe meta access, ok
- }
- my $metadata_file = File::Spec->catfile($CPAN::Config->{cpan_home},"Metadata");
- $cache->{last_time} = $LAST_TIME;
- $cache->{DATE_OF_02} = $DATE_OF_02;
- $cache->{PROTOCOL} = PROTOCOL;
- $CPAN::Frontend->myprint("Going to write $metadata_file\n");
- eval { Storable::nstore($cache, $metadata_file) };
- $CPAN::Frontend->mywarn($@) if $@; # ?? missing "\n" after $@ in mywarn ??
-}
-
-#-> sub CPAN::Index::read_metadata_cache ;
-sub read_metadata_cache {
- my($self) = @_;
- return unless $CPAN::Config->{'cache_metadata'};
- return if CPAN::_sqlite_running;
- return unless $CPAN::META->has_usable("Storable");
- my $metadata_file = File::Spec->catfile($CPAN::Config->{cpan_home},"Metadata");
- return unless -r $metadata_file and -f $metadata_file;
- $CPAN::Frontend->myprint("Going to read $metadata_file\n");
- my $cache;
- eval { $cache = Storable::retrieve($metadata_file) };
- $CPAN::Frontend->mywarn($@) if $@; # ?? missing "\n" after $@ in mywarn ??
- if (!$cache || !UNIVERSAL::isa($cache, 'HASH')) {
- $LAST_TIME = 0;
- return;
- }
- if (exists $cache->{PROTOCOL}) {
- if (PROTOCOL > $cache->{PROTOCOL}) {
- $CPAN::Frontend->mywarn(sprintf("Ignoring Metadata cache written ".
- "with protocol v%s, requiring v%s\n",
- $cache->{PROTOCOL},
- PROTOCOL)
- );
- return;
- }
- } else {
- $CPAN::Frontend->mywarn("Ignoring Metadata cache written ".
- "with protocol v1.0\n");
- return;
- }
- my $clcnt = 0;
- my $idcnt = 0;
- while(my($class,$v) = each %$cache) {
- next unless $class =~ /^CPAN::/;
- $CPAN::META->{readonly}{$class} = $v; # unsafe meta access, ok
- while (my($id,$ro) = each %$v) {
- $CPAN::META->{readwrite}{$class}{$id} ||=
- $class->new(ID=>$id, RO=>$ro);
- $idcnt++;
- }
- $clcnt++;
- }
- unless ($clcnt) { # sanity check
- $CPAN::Frontend->myprint("Warning: Found no data in $metadata_file\n");
- return;
- }
- if ($idcnt < 1000) {
- $CPAN::Frontend->myprint("Warning: Found only $idcnt objects ".
- "in $metadata_file\n");
- return;
- }
- $CPAN::META->{PROTOCOL} ||=
- $cache->{PROTOCOL}; # reading does not up or downgrade, but it
- # does initialize to some protocol
- $LAST_TIME = $cache->{last_time};
- $DATE_OF_02 = $cache->{DATE_OF_02};
- $CPAN::Frontend->myprint(" Database was generated on $DATE_OF_02\n")
- if defined $DATE_OF_02; # An old cache may not contain DATE_OF_02
- return;
-}
-
-package CPAN::InfoObj;
-use strict;
-
-sub ro {
- my $self = shift;
- exists $self->{RO} and return $self->{RO};
-}
-
-#-> sub CPAN::InfoObj::cpan_userid
-sub cpan_userid {
- my $self = shift;
- my $ro = $self->ro;
- if ($ro) {
- return $ro->{CPAN_USERID} || "N/A";
- } else {
- $self->debug("ID[$self->{ID}]");
- # N/A for bundles found locally
- return "N/A";
- }
-}
-
-sub id { shift->{ID}; }
-
-#-> sub CPAN::InfoObj::new ;
-sub new {
- my $this = bless {}, shift;
- %$this = @_;
- $this
-}
-
-# The set method may only be used by code that reads index data or
-# otherwise "objective" data from the outside world. All session
-# related material may do anything else with instance variables but
-# must not touch the hash under the RO attribute. The reason is that
-# the RO hash gets written to Metadata file and is thus persistent.
-
-#-> sub CPAN::InfoObj::safe_chdir ;
-sub safe_chdir {
- my($self,$todir) = @_;
- # we die if we cannot chdir and we are debuggable
- Carp::confess("safe_chdir called without todir argument")
- unless defined $todir and length $todir;
- if (chdir $todir) {
- $self->debug(sprintf "changed directory to %s", CPAN::anycwd())
- if $CPAN::DEBUG;
- } else {
- if (-e $todir) {
- unless (-x $todir) {
- unless (chmod 0755, $todir) {
- my $cwd = CPAN::anycwd();
- $CPAN::Frontend->mywarn("I have neither the -x permission nor the ".
- "permission to change the permission; cannot ".
- "chdir to '$todir'\n");
- $CPAN::Frontend->mysleep(5);
- $CPAN::Frontend->mydie(qq{Could not chdir from cwd[$cwd] }.
- qq{to todir[$todir]: $!});
- }
- }
- } else {
- $CPAN::Frontend->mydie("Directory '$todir' has gone. Cannot continue.\n");
- }
- if (chdir $todir) {
- $self->debug(sprintf "changed directory to %s", CPAN::anycwd())
- if $CPAN::DEBUG;
- } else {
- my $cwd = CPAN::anycwd();
- $CPAN::Frontend->mydie(qq{Could not chdir from cwd[$cwd] }.
- qq{to todir[$todir] (a chmod has been issued): $!});
- }
- }
-}
-
-#-> sub CPAN::InfoObj::set ;
-sub set {
- my($self,%att) = @_;
- my $class = ref $self;
-
- # This must be ||=, not ||, because only if we write an empty
- # reference, only then the set method will write into the readonly
- # area. But for Distributions that spring into existence, maybe
- # because of a typo, we do not like it that they are written into
- # the readonly area and made permanent (at least for a while) and
- # that is why we do not "allow" other places to call ->set.
- unless ($self->id) {
- CPAN->debug("Bug? Empty ID, rejecting");
- return;
- }
- my $ro = $self->{RO} =
- $CPAN::META->{readonly}{$class}{$self->id} ||= {};
-
- while (my($k,$v) = each %att) {
- $ro->{$k} = $v;
- }
-}
-
-#-> sub CPAN::InfoObj::as_glimpse ;
-sub as_glimpse {
- my($self) = @_;
- my(@m);
- my $class = ref($self);
- $class =~ s/^CPAN:://;
- my $id = $self->can("pretty_id") ? $self->pretty_id : $self->{ID};
- push @m, sprintf "%-15s %s\n", $class, $id;
- join "", @m;
-}
-
-#-> sub CPAN::InfoObj::as_string ;
-sub as_string {
- my($self) = @_;
- my(@m);
- my $class = ref($self);
- $class =~ s/^CPAN:://;
- push @m, $class, " id = $self->{ID}\n";
- my $ro;
- unless ($ro = $self->ro) {
- if (substr($self->{ID},-1,1) eq ".") { # directory
- $ro = +{};
- } else {
- $CPAN::Frontend->mywarn("Unknown object $self->{ID}\n");
- $CPAN::Frontend->mysleep(5);
- return;
- }
- }
- for (sort keys %$ro) {
- # next if m/^(ID|RO)$/;
- my $extra = "";
- if ($_ eq "CPAN_USERID") {
- $extra .= " (";
- $extra .= $self->fullname;
- my $email; # old perls!
- if ($email = $CPAN::META->instance("CPAN::Author",
- $self->cpan_userid
- )->email) {
- $extra .= " <$email>";
- } else {
- $extra .= " <no email>";
- }
- $extra .= ")";
- } elsif ($_ eq "FULLNAME") { # potential UTF-8 conversion
- push @m, sprintf " %-12s %s\n", $_, $self->fullname;
- next;
- }
- next unless defined $ro->{$_};
- push @m, sprintf " %-12s %s%s\n", $_, $ro->{$_}, $extra;
- }
- KEY: for (sort keys %$self) {
- next if m/^(ID|RO)$/;
- unless (defined $self->{$_}) {
- delete $self->{$_};
- next KEY;
- }
- if (ref($self->{$_}) eq "ARRAY") {
- push @m, sprintf " %-12s %s\n", $_, "@{$self->{$_}}";
- } elsif (ref($self->{$_}) eq "HASH") {
- my $value;
- if (/^CONTAINSMODS$/) {
- $value = join(" ",sort keys %{$self->{$_}});
- } elsif (/^prereq_pm$/) {
- my @value;
- my $v = $self->{$_};
- for my $x (sort keys %$v) {
- my @svalue;
- for my $y (sort keys %{$v->{$x}}) {
- push @svalue, "$y=>$v->{$x}{$y}";
- }
- push @value, "$x\:" . join ",", @svalue if @svalue;
- }
- $value = join ";", @value;
- } else {
- $value = $self->{$_};
- }
- push @m, sprintf(
- " %-12s %s\n",
- $_,
- $value,
- );
- } else {
- push @m, sprintf " %-12s %s\n", $_, $self->{$_};
- }
- }
- join "", @m, "\n";
-}
-
-#-> sub CPAN::InfoObj::fullname ;
-sub fullname {
- my($self) = @_;
- $CPAN::META->instance("CPAN::Author",$self->cpan_userid)->fullname;
-}
-
-#-> sub CPAN::InfoObj::dump ;
-sub dump {
- my($self, $what) = @_;
- unless ($CPAN::META->has_inst("Data::Dumper")) {
- $CPAN::Frontend->mydie("dump command requires Data::Dumper installed");
- }
- local $Data::Dumper::Sortkeys;
- $Data::Dumper::Sortkeys = 1;
- my $out = Data::Dumper::Dumper($what ? eval $what : $self);
- if (length $out > 100000) {
- my $fh_pager = FileHandle->new;
- local($SIG{PIPE}) = "IGNORE";
- my $pager = $CPAN::Config->{'pager'} || "cat";
- $fh_pager->open("|$pager")
- or die "Could not open pager $pager\: $!";
- $fh_pager->print($out);
- close $fh_pager;
- } else {
- $CPAN::Frontend->myprint($out);
- }
-}
-
-package CPAN::Author;
-use strict;
-
-#-> sub CPAN::Author::force
-sub force {
- my $self = shift;
- $self->{force}++;
-}
-
-#-> sub CPAN::Author::force
-sub unforce {
- my $self = shift;
- delete $self->{force};
-}
-
-#-> sub CPAN::Author::id
-sub id {
- my $self = shift;
- my $id = $self->{ID};
- $CPAN::Frontend->mydie("Illegal author id[$id]") unless $id =~ /^[A-Z]/;
- $id;
-}
-
-#-> sub CPAN::Author::as_glimpse ;
-sub as_glimpse {
- my($self) = @_;
- my(@m);
- my $class = ref($self);
- $class =~ s/^CPAN:://;
- push @m, sprintf(qq{%-15s %s ("%s" <%s>)\n},
- $class,
- $self->{ID},
- $self->fullname,
- $self->email);
- join "", @m;
-}
-
-#-> sub CPAN::Author::fullname ;
-sub fullname {
- shift->ro->{FULLNAME};
-}
-*name = \&fullname;
-
-#-> sub CPAN::Author::email ;
-sub email { shift->ro->{EMAIL}; }
-
-#-> sub CPAN::Author::ls ;
-sub ls {
- my $self = shift;
- my $glob = shift || "";
- my $silent = shift || 0;
- my $id = $self->id;
-
- # adapted from CPAN::Distribution::verifyCHECKSUM ;
- my(@csf); # chksumfile
- @csf = $self->id =~ /(.)(.)(.*)/;
- $csf[1] = join "", @csf[0,1];
- $csf[2] = join "", @csf[1,2]; # ("A","AN","ANDK")
- my(@dl);
- @dl = $self->dir_listing([$csf[0],"CHECKSUMS"], 0, 1);
- unless (grep {$_->[2] eq $csf[1]} @dl) {
- $CPAN::Frontend->myprint("Directory $csf[1]/ does not exist\n") unless $silent ;
- return;
- }
- @dl = $self->dir_listing([@csf[0,1],"CHECKSUMS"], 0, 1);
- unless (grep {$_->[2] eq $csf[2]} @dl) {
- $CPAN::Frontend->myprint("Directory $id/ does not exist\n") unless $silent;
- return;
- }
- @dl = $self->dir_listing([@csf,"CHECKSUMS"], 1, 1);
- if ($glob) {
- if ($CPAN::META->has_inst("Text::Glob")) {
- my $rglob = Text::Glob::glob_to_regex($glob);
- @dl = grep { $_->[2] =~ /$rglob/ } @dl;
- } else {
- $CPAN::Frontend->mydie("Text::Glob not installed, cannot proceed");
- }
- }
- unless ($silent >= 2) {
- $CPAN::Frontend->myprint(join "", map {
- sprintf("%8d %10s %s/%s\n", $_->[0], $_->[1], $id, $_->[2])
- } sort { $a->[2] cmp $b->[2] } @dl);
- }
- @dl;
-}
-
-# returns an array of arrays, the latter contain (size,mtime,filename)
-#-> sub CPAN::Author::dir_listing ;
-sub dir_listing {
- my $self = shift;
- my $chksumfile = shift;
- my $recursive = shift;
- my $may_ftp = shift;
-
- my $lc_want =
- File::Spec->catfile($CPAN::Config->{keep_source_where},
- "authors", "id", @$chksumfile);
-
- my $fh;
-
- # Purge and refetch old (pre-PGP) CHECKSUMS; they are a security
- # hazard. (Without GPG installed they are not that much better,
- # though.)
- $fh = FileHandle->new;
- if (open($fh, $lc_want)) {
- my $line = <$fh>; close $fh;
- unlink($lc_want) unless $line =~ /PGP/;
- }
-
- local($") = "/";
- # connect "force" argument with "index_expire".
- my $force = $self->{force};
- if (my @stat = stat $lc_want) {
- $force ||= $stat[9] + $CPAN::Config->{index_expire}*86400 <= time;
- }
- my $lc_file;
- if ($may_ftp) {
- $lc_file = CPAN::FTP->localize(
- "authors/id/@$chksumfile",
- $lc_want,
- $force,
- );
- unless ($lc_file) {
- $CPAN::Frontend->myprint("Trying $lc_want.gz\n");
- $chksumfile->[-1] .= ".gz";
- $lc_file = CPAN::FTP->localize("authors/id/@$chksumfile",
- "$lc_want.gz",1);
- if ($lc_file) {
- $lc_file =~ s{\.gz(?!\n)\Z}{}; #};
- eval{CPAN::Tarzip->new("$lc_file.gz")->gunzip($lc_file)};
- } else {
- return;
- }
- }
- } else {
- $lc_file = $lc_want;
- # we *could* second-guess and if the user has a file: URL,
- # then we could look there. But on the other hand, if they do
- # have a file: URL, wy did they choose to set
- # $CPAN::Config->{show_upload_date} to false?
- }
-
- # adapted from CPAN::Distribution::CHECKSUM_check_file ;
- $fh = FileHandle->new;
- my($cksum);
- if (open $fh, $lc_file) {
- local($/);
- my $eval = <$fh>;
- $eval =~ s/\015?\012/\n/g;
- close $fh;
- my($comp) = Safe->new();
- $cksum = $comp->reval($eval);
- if ($@) {
- rename $lc_file, "$lc_file.bad";
- Carp::confess($@) if $@;
- }
- } elsif ($may_ftp) {
- Carp::carp "Could not open '$lc_file' for reading.";
- } else {
- # Maybe should warn: "You may want to set show_upload_date to a true value"
- return;
- }
- my(@result,$f);
- for $f (sort keys %$cksum) {
- if (exists $cksum->{$f}{isdir}) {
- if ($recursive) {
- my(@dir) = @$chksumfile;
- pop @dir;
- push @dir, $f, "CHECKSUMS";
- push @result, map {
- [$_->[0], $_->[1], "$f/$_->[2]"]
- } $self->dir_listing(\@dir,1,$may_ftp);
- } else {
- push @result, [ 0, "-", $f ];
- }
- } else {
- push @result, [
- ($cksum->{$f}{"size"}||0),
- $cksum->{$f}{"mtime"}||"---",
- $f
- ];
- }
- }
- @result;
-}
-
-#-> sub CPAN::Author::reports
-sub reports {
- $CPAN::Frontend->mywarn("reports on authors not implemented.
-Please file a bugreport if you need this.\n");
-}
-
-package CPAN::Distribution;
-use strict;
-
-# Accessors
-sub cpan_comment {
- my $self = shift;
- my $ro = $self->ro or return;
- $ro->{CPAN_COMMENT}
-}
-
-#-> CPAN::Distribution::undelay
-sub undelay {
- my $self = shift;
- for my $delayer (
- "configure_requires_later",
- "configure_requires_later_for",
- "later",
- "later_for",
- ) {
- delete $self->{$delayer};
- }
-}
-
-#-> CPAN::Distribution::is_dot_dist
-sub is_dot_dist {
- my($self) = @_;
- return substr($self->id,-1,1) eq ".";
-}
-
-# add the A/AN/ stuff
-#-> CPAN::Distribution::normalize
-sub normalize {
- my($self,$s) = @_;
- $s = $self->id unless defined $s;
- if (substr($s,-1,1) eq ".") {
- # using a global because we are sometimes called as static method
- if (!$CPAN::META->{LOCK}
- && !$CPAN::Have_warned->{"$s is unlocked"}++
- ) {
- $CPAN::Frontend->mywarn("You are visiting the local directory
- '$s'
- without lock, take care that concurrent processes do not do likewise.\n");
- $CPAN::Frontend->mysleep(1);
- }
- if ($s eq ".") {
- $s = "$CPAN::iCwd/.";
- } elsif (File::Spec->file_name_is_absolute($s)) {
- } elsif (File::Spec->can("rel2abs")) {
- $s = File::Spec->rel2abs($s);
- } else {
- $CPAN::Frontend->mydie("Your File::Spec is too old, please upgrade File::Spec");
- }
- CPAN->debug("s[$s]") if $CPAN::DEBUG;
- unless ($CPAN::META->exists("CPAN::Distribution", $s)) {
- for ($CPAN::META->instance("CPAN::Distribution", $s)) {
- $_->{build_dir} = $s;
- $_->{archived} = "local_directory";
- $_->{unwrapped} = CPAN::Distrostatus->new("YES -- local_directory");
- }
- }
- } elsif (
- $s =~ tr|/|| == 1
- or
- $s !~ m|[A-Z]/[A-Z-]{2}/[A-Z-]{2,}/|
- ) {
- return $s if $s =~ m:^N/A|^Contact Author: ;
- $s =~ s|^(.)(.)([^/]*/)(.+)$|$1/$1$2/$1$2$3$4| or
- $CPAN::Frontend->mywarn("Strange distribution name [$s]\n");
- CPAN->debug("s[$s]") if $CPAN::DEBUG;
- }
- $s;
-}
-
-#-> sub CPAN::Distribution::author ;
-sub author {
- my($self) = @_;
- my($authorid);
- if (substr($self->id,-1,1) eq ".") {
- $authorid = "LOCAL";
- } else {
- ($authorid) = $self->pretty_id =~ /^([\w\-]+)/;
- }
- CPAN::Shell->expand("Author",$authorid);
-}
-
-# tries to get the yaml from CPAN instead of the distro itself:
-# EXPERIMENTAL, UNDOCUMENTED AND UNTESTED, for Tels
-sub fast_yaml {
- my($self) = @_;
- my $meta = $self->pretty_id;
- $meta =~ s/\.(tar.gz|tgz|zip|tar.bz2)/.meta/;
- my(@ls) = CPAN::Shell->globls($meta);
- my $norm = $self->normalize($meta);
-
- my($local_file);
- my($local_wanted) =
- File::Spec->catfile(
- $CPAN::Config->{keep_source_where},
- "authors",
- "id",
- split(/\//,$norm)
- );
- $self->debug("Doing localize") if $CPAN::DEBUG;
- unless ($local_file =
- CPAN::FTP->localize("authors/id/$norm",
- $local_wanted)) {
- $CPAN::Frontend->mydie("Giving up on downloading yaml file '$local_wanted'\n");
- }
- my $yaml = CPAN->_yaml_loadfile($local_file)->[0];
-}
-
-#-> sub CPAN::Distribution::cpan_userid
-sub cpan_userid {
- my $self = shift;
- if ($self->{ID} =~ m{[A-Z]/[A-Z\-]{2}/([A-Z\-]+)/}) {
- return $1;
- }
- return $self->SUPER::cpan_userid;
-}
-
-#-> sub CPAN::Distribution::pretty_id
-sub pretty_id {
- my $self = shift;
- my $id = $self->id;
- return $id unless $id =~ m|^./../|;
- substr($id,5);
-}
-
-#-> sub CPAN::Distribution::base_id
-sub base_id {
- my $self = shift;
- my $id = $self->pretty_id();
- my $base_id = File::Basename::basename($id);
- $base_id =~ s{\.(?:tar\.(bz2|gz|Z)|t(?:gz|bz)|zip)$}{}i;
- return $base_id;
-}
-
-# mark as dirty/clean for the sake of recursion detection. $color=1
-# means "in use", $color=0 means "not in use anymore". $color=2 means
-# we have determined prereqs now and thus insist on passing this
-# through (at least) once again.
-
-#-> sub CPAN::Distribution::color_cmd_tmps ;
-sub color_cmd_tmps {
- my($self) = shift;
- my($depth) = shift || 0;
- my($color) = shift || 0;
- my($ancestors) = shift || [];
- # a distribution needs to recurse into its prereq_pms
-
- return if exists $self->{incommandcolor}
- && $color==1
- && $self->{incommandcolor}==$color;
- if ($depth>=$CPAN::MAX_RECURSION) {
- die(CPAN::Exception::RecursiveDependency->new($ancestors));
- }
- # warn "color_cmd_tmps $depth $color " . $self->id; # sleep 1;
- my $prereq_pm = $self->prereq_pm;
- if (defined $prereq_pm) {
- PREREQ: for my $pre (keys %{$prereq_pm->{requires}||{}},
- keys %{$prereq_pm->{build_requires}||{}}) {
- next PREREQ if $pre eq "perl";
- my $premo;
- unless ($premo = CPAN::Shell->expand("Module",$pre)) {
- $CPAN::Frontend->mywarn("prerequisite module[$pre] not known\n");
- $CPAN::Frontend->mysleep(2);
- next PREREQ;
- }
- $premo->color_cmd_tmps($depth+1,$color,[@$ancestors, $self->id]);
- }
- }
- if ($color==0) {
- delete $self->{sponsored_mods};
-
- # as we are at the end of a command, we'll give up this
- # reminder of a broken test. Other commands may test this guy
- # again. Maybe 'badtestcnt' should be renamed to
- # 'make_test_failed_within_command'?
- delete $self->{badtestcnt};
- }
- $self->{incommandcolor} = $color;
-}
-
-#-> sub CPAN::Distribution::as_string ;
-sub as_string {
- my $self = shift;
- $self->containsmods;
- $self->upload_date;
- $self->SUPER::as_string(@_);
-}
-
-#-> sub CPAN::Distribution::containsmods ;
-sub containsmods {
- my $self = shift;
- return keys %{$self->{CONTAINSMODS}} if exists $self->{CONTAINSMODS};
- my $dist_id = $self->{ID};
- for my $mod ($CPAN::META->all_objects("CPAN::Module")) {
- my $mod_file = $mod->cpan_file or next;
- my $mod_id = $mod->{ID} or next;
- # warn "mod_file[$mod_file] dist_id[$dist_id] mod_id[$mod_id]";
- # sleep 1;
- if ($CPAN::Signal) {
- delete $self->{CONTAINSMODS};
- return;
- }
- $self->{CONTAINSMODS}{$mod_id} = undef if $mod_file eq $dist_id;
- }
- keys %{$self->{CONTAINSMODS}||={}};
-}
-
-#-> sub CPAN::Distribution::upload_date ;
-sub upload_date {
- my $self = shift;
- return $self->{UPLOAD_DATE} if exists $self->{UPLOAD_DATE};
- my(@local_wanted) = split(/\//,$self->id);
- my $filename = pop @local_wanted;
- push @local_wanted, "CHECKSUMS";
- my $author = CPAN::Shell->expand("Author",$self->cpan_userid);
- return unless $author;
- my @dl = $author->dir_listing(\@local_wanted,0,$CPAN::Config->{show_upload_date});
- return unless @dl;
- my($dirent) = grep { $_->[2] eq $filename } @dl;
- # warn sprintf "dirent[%s]id[%s]", $dirent, $self->id;
- return unless $dirent->[1];
- return $self->{UPLOAD_DATE} = $dirent->[1];
-}
-
-#-> sub CPAN::Distribution::uptodate ;
-sub uptodate {
- my($self) = @_;
- my $c;
- foreach $c ($self->containsmods) {
- my $obj = CPAN::Shell->expandany($c);
- unless ($obj->uptodate) {
- my $id = $self->pretty_id;
- $self->debug("$id not uptodate due to $c") if $CPAN::DEBUG;
- return 0;
- }
- }
- return 1;
-}
-
-#-> sub CPAN::Distribution::called_for ;
-sub called_for {
- my($self,$id) = @_;
- $self->{CALLED_FOR} = $id if defined $id;
- return $self->{CALLED_FOR};
-}
-
-#-> sub CPAN::Distribution::get ;
-sub get {
- my($self) = @_;
- $self->debug("checking goto id[$self->{ID}]") if $CPAN::DEBUG;
- if (my $goto = $self->prefs->{goto}) {
- $CPAN::Frontend->mywarn
- (sprintf(
- "delegating to '%s' as specified in prefs file '%s' doc %d\n",
- $goto,
- $self->{prefs_file},
- $self->{prefs_file_doc},
- ));
- return $self->goto($goto);
- }
- local $ENV{PERL5LIB} = defined($ENV{PERL5LIB})
- ? $ENV{PERL5LIB}
- : ($ENV{PERLLIB} || "");
-
- $CPAN::META->set_perl5lib;
- local $ENV{MAKEFLAGS}; # protect us from outer make calls
-
- EXCUSE: {
- my @e;
- my $goodbye_message;
- $self->debug("checking disabled id[$self->{ID}]") if $CPAN::DEBUG;
- if ($self->prefs->{disabled}) {
- my $why = sprintf(
- "Disabled via prefs file '%s' doc %d",
- $self->{prefs_file},
- $self->{prefs_file_doc},
- );
- push @e, $why;
- $self->{unwrapped} = CPAN::Distrostatus->new("NO $why");
- $goodbye_message = "[disabled] -- NA $why";
- # note: not intended to be persistent but at least visible
- # during this session
- } else {
- if (exists $self->{build_dir} && -d $self->{build_dir}
- && ($self->{modulebuild}||$self->{writemakefile})
- ) {
- # this deserves print, not warn:
- $CPAN::Frontend->myprint(" Has already been unwrapped into directory ".
- "$self->{build_dir}\n"
- );
- return 1;
- }
-
- # although we talk about 'force' we shall not test on
- # force directly. New model of force tries to refrain from
- # direct checking of force.
- exists $self->{unwrapped} and (
- UNIVERSAL::can($self->{unwrapped},"failed") ?
- $self->{unwrapped}->failed :
- $self->{unwrapped} =~ /^NO/
- )
- and push @e, "Unwrapping had some problem, won't try again without force";
- }
- if (@e) {
- $CPAN::Frontend->mywarn(join "", map {"$_\n"} @e);
- if ($goodbye_message) {
- $self->goodbye($goodbye_message);
- }
- return;
- }
- }
- my $sub_wd = CPAN::anycwd(); # for cleaning up as good as possible
-
- my($local_file);
- unless ($self->{build_dir} && -d $self->{build_dir}) {
- $self->get_file_onto_local_disk;
- return if $CPAN::Signal;
- $self->check_integrity;
- return if $CPAN::Signal;
- (my $packagedir,$local_file) = $self->run_preps_on_packagedir;
- $packagedir ||= $self->{build_dir};
- $self->{build_dir} = $packagedir;
- }
-
- if ($CPAN::Signal) {
- $self->safe_chdir($sub_wd);
- return;
- }
- return $self->run_MM_or_MB($local_file);
-}
-
-#-> CPAN::Distribution::get_file_onto_local_disk
-sub get_file_onto_local_disk {
- my($self) = @_;
-
- return if $self->is_dot_dist;
- my($local_file);
- my($local_wanted) =
- File::Spec->catfile(
- $CPAN::Config->{keep_source_where},
- "authors",
- "id",
- split(/\//,$self->id)
- );
-
- $self->debug("Doing localize") if $CPAN::DEBUG;
- unless ($local_file =
- CPAN::FTP->localize("authors/id/$self->{ID}",
- $local_wanted)) {
- my $note = "";
- if ($CPAN::Index::DATE_OF_02) {
- $note = "Note: Current database in memory was generated ".
- "on $CPAN::Index::DATE_OF_02\n";
- }
- $CPAN::Frontend->mydie("Giving up on '$local_wanted'\n$note");
- }
-
- $self->debug("local_wanted[$local_wanted]local_file[$local_file]") if $CPAN::DEBUG;
- $self->{localfile} = $local_file;
-}
-
-
-#-> CPAN::Distribution::check_integrity
-sub check_integrity {
- my($self) = @_;
-
- return if $self->is_dot_dist;
- if ($CPAN::META->has_inst("Digest::SHA")) {
- $self->debug("Digest::SHA is installed, verifying");
- $self->verifyCHECKSUM;
- } else {
- $self->debug("Digest::SHA is NOT installed");
- }
-}
-
-#-> CPAN::Distribution::run_preps_on_packagedir
-sub run_preps_on_packagedir {
- my($self) = @_;
- return if $self->is_dot_dist;
-
- $CPAN::META->{cachemgr} ||= CPAN::CacheMgr->new(); # unsafe meta access, ok
- my $builddir = $CPAN::META->{cachemgr}->dir; # unsafe meta access, ok
- $self->safe_chdir($builddir);
- $self->debug("Removing tmp-$$") if $CPAN::DEBUG;
- File::Path::rmtree("tmp-$$");
- unless (mkdir "tmp-$$", 0755) {
- $CPAN::Frontend->unrecoverable_error(<<EOF);
-Couldn't mkdir '$builddir/tmp-$$': $!
-
-Cannot continue: Please find the reason why I cannot make the
-directory
-$builddir/tmp-$$
-and fix the problem, then retry.
-
-EOF
- }
- if ($CPAN::Signal) {
- return;
- }
- $self->safe_chdir("tmp-$$");
-
- #
- # Unpack the goods
- #
- my $local_file = $self->{localfile};
- my $ct = eval{CPAN::Tarzip->new($local_file)};
- unless ($ct) {
- $self->{unwrapped} = CPAN::Distrostatus->new("NO");
- delete $self->{build_dir};
- return;
- }
- if ($local_file =~ /(\.tar\.(bz2|gz|Z)|\.tgz)(?!\n)\Z/i) {
- $self->{was_uncompressed}++ unless eval{$ct->gtest()};
- $self->untar_me($ct);
- } elsif ( $local_file =~ /\.zip(?!\n)\Z/i ) {
- $self->unzip_me($ct);
- } else {
- $self->{was_uncompressed}++ unless $ct->gtest();
- $local_file = $self->handle_singlefile($local_file);
- }
-
- # we are still in the tmp directory!
- # Let's check if the package has its own directory.
- my $dh = DirHandle->new(File::Spec->curdir)
- or Carp::croak("Couldn't opendir .: $!");
- my @readdir = grep $_ !~ /^\.\.?(?!\n)\Z/s, $dh->read; ### MAC??
- $dh->close;
- my ($packagedir);
- # XXX here we want in each branch File::Temp to protect all build_dir directories
- if (CPAN->has_usable("File::Temp")) {
- my $tdir_base;
- my $from_dir;
- my @dirents;
- if (@readdir == 1 && -d $readdir[0]) {
- $tdir_base = $readdir[0];
- $from_dir = File::Spec->catdir(File::Spec->curdir,$readdir[0]);
- my $dh2 = DirHandle->new($from_dir)
- or Carp::croak("Couldn't opendir $from_dir: $!");
- @dirents = grep $_ !~ /^\.\.?(?!\n)\Z/s, $dh2->read; ### MAC??
- } else {
- my $userid = $self->cpan_userid;
- CPAN->debug("userid[$userid]");
- if (!$userid or $userid eq "N/A") {
- $userid = "anon";
- }
- $tdir_base = $userid;
- $from_dir = File::Spec->curdir;
- @dirents = @readdir;
- }
- $packagedir = File::Temp::tempdir(
- "$tdir_base-XXXXXX",
- DIR => $builddir,
- CLEANUP => 0,
- );
- my $f;
- for $f (@dirents) { # is already without "." and ".."
- my $from = File::Spec->catdir($from_dir,$f);
- my $to = File::Spec->catdir($packagedir,$f);
- unless (File::Copy::move($from,$to)) {
- my $err = $!;
- $from = File::Spec->rel2abs($from);
- Carp::confess("Couldn't move $from to $to: $err");
- }
- }
- } else { # older code below, still better than nothing when there is no File::Temp
- my($distdir);
- if (@readdir == 1 && -d $readdir[0]) {
- $distdir = $readdir[0];
- $packagedir = File::Spec->catdir($builddir,$distdir);
- $self->debug("packagedir[$packagedir]builddir[$builddir]distdir[$distdir]")
- if $CPAN::DEBUG;
- -d $packagedir and $CPAN::Frontend->myprint("Removing previously used ".
- "$packagedir\n");
- File::Path::rmtree($packagedir);
- unless (File::Copy::move($distdir,$packagedir)) {
- $CPAN::Frontend->unrecoverable_error(<<EOF);
-Couldn't move '$distdir' to '$packagedir': $!
-
-Cannot continue: Please find the reason why I cannot move
-$builddir/tmp-$$/$distdir
-to
-$packagedir
-and fix the problem, then retry
-
-EOF
- }
- $self->debug(sprintf("moved distdir[%s] to packagedir[%s] -e[%s]-d[%s]",
- $distdir,
- $packagedir,
- -e $packagedir,
- -d $packagedir,
- )) if $CPAN::DEBUG;
- } else {
- my $userid = $self->cpan_userid;
- CPAN->debug("userid[$userid]") if $CPAN::DEBUG;
- if (!$userid or $userid eq "N/A") {
- $userid = "anon";
- }
- my $pragmatic_dir = $userid . '000';
- $pragmatic_dir =~ s/\W_//g;
- $pragmatic_dir++ while -d "../$pragmatic_dir";
- $packagedir = File::Spec->catdir($builddir,$pragmatic_dir);
- $self->debug("packagedir[$packagedir]") if $CPAN::DEBUG;
- File::Path::mkpath($packagedir);
- my($f);
- for $f (@readdir) { # is already without "." and ".."
- my $to = File::Spec->catdir($packagedir,$f);
- File::Copy::move($f,$to) or Carp::confess("Couldn't move $f to $to: $!");
- }
- }
- }
- $self->{build_dir} = $packagedir;
- $self->safe_chdir($builddir);
- File::Path::rmtree("tmp-$$");
-
- $self->safe_chdir($packagedir);
- $self->_signature_business();
- $self->safe_chdir($builddir);
-
- return($packagedir,$local_file);
-}
-
-#-> sub CPAN::Distribution::parse_meta_yml ;
-sub parse_meta_yml {
- my($self) = @_;
- my $build_dir = $self->{build_dir} or die "PANIC: cannot parse yaml without a build_dir";
- my $yaml = File::Spec->catfile($build_dir,"META.yml");
- $self->debug("yaml[$yaml]") if $CPAN::DEBUG;
- return unless -f $yaml;
- my $early_yaml;
- eval {
- require Parse::Metayaml; # hypothetical
- $early_yaml = Parse::Metayaml::LoadFile($yaml)->[0];
- };
- unless ($early_yaml) {
- eval { $early_yaml = CPAN->_yaml_loadfile($yaml)->[0]; };
- }
- unless ($early_yaml) {
- return;
- }
- return $early_yaml;
-}
-
-#-> sub CPAN::Distribution::satisfy_configure_requires ;
-sub satisfy_configure_requires {
- my($self) = @_;
- my $enable_configure_requires = 1;
- if (!$enable_configure_requires) {
- return 1;
- # if we return 1 here, everything is as before we introduced
- # configure_requires that means, things with
- # configure_requires simply fail, all others succeed
- }
- my @prereq = $self->unsat_prereq("configure_requires_later") or return 1;
- if ($self->{configure_requires_later}) {
- for my $k (keys %{$self->{configure_requires_later_for}||{}}) {
- if ($self->{configure_requires_later_for}{$k}>1) {
- # we must not come here a second time
- $CPAN::Frontend->mywarn("Panic: Some prerequisites is not available, please investigate...");
- require YAML::Syck;
- $CPAN::Frontend->mydie
- (
- YAML::Syck::Dump
- ({self=>$self, prereq=>\@prereq})
- );
- }
- }
- }
- if ($prereq[0][0] eq "perl") {
- my $need = "requires perl '$prereq[0][1]'";
- my $id = $self->pretty_id;
- $CPAN::Frontend->mywarn("$id $need; you have only $]; giving up\n");
- $self->{make} = CPAN::Distrostatus->new("NO $need");
- $self->store_persistent_state;
- return $self->goodbye("[prereq] -- NOT OK");
- } else {
- my $follow = eval {
- $self->follow_prereqs("configure_requires_later", @prereq);
- };
- if (0) {
- } elsif ($follow) {
- return;
- } elsif ($@ && ref $@ && $@->isa("CPAN::Exception::RecursiveDependency")) {
- $CPAN::Frontend->mywarn($@);
- return $self->goodbye("[depend] -- NOT OK");
- }
- }
- die "never reached";
-}
-
-#-> sub CPAN::Distribution::run_MM_or_MB ;
-sub run_MM_or_MB {
- my($self,$local_file) = @_;
- $self->satisfy_configure_requires() or return;
- my($mpl) = File::Spec->catfile($self->{build_dir},"Makefile.PL");
- my($mpl_exists) = -f $mpl;
- unless ($mpl_exists) {
- # NFS has been reported to have racing problems after the
- # renaming of a directory in some environments.
- # This trick helps.
- $CPAN::Frontend->mysleep(1);
- my $mpldh = DirHandle->new($self->{build_dir})
- or Carp::croak("Couldn't opendir $self->{build_dir}: $!");
- $mpl_exists = grep /^Makefile\.PL$/, $mpldh->read;
- $mpldh->close;
- }
- my $prefer_installer = "eumm"; # eumm|mb
- if (-f File::Spec->catfile($self->{build_dir},"Build.PL")) {
- if ($mpl_exists) { # they *can* choose
- if ($CPAN::META->has_inst("Module::Build")) {
- $prefer_installer = CPAN::HandleConfig->prefs_lookup($self,
- q{prefer_installer});
- }
- } else {
- $prefer_installer = "mb";
- }
- }
- return unless $self->patch;
- if (lc($prefer_installer) eq "rand") {
- $prefer_installer = rand()<.5 ? "eumm" : "mb";
- }
- if (lc($prefer_installer) eq "mb") {
- $self->{modulebuild} = 1;
- } elsif ($self->{archived} eq "patch") {
- # not an edge case, nothing to install for sure
- my $why = "A patch file cannot be installed";
- $CPAN::Frontend->mywarn("Refusing to handle this file: $why\n");
- $self->{writemakefile} = CPAN::Distrostatus->new("NO $why");
- } elsif (! $mpl_exists) {
- $self->_edge_cases($mpl,$local_file);
- }
- if ($self->{build_dir}
- &&
- $CPAN::Config->{build_dir_reuse}
- ) {
- $self->store_persistent_state;
- }
- return $self;
-}
-
-#-> CPAN::Distribution::store_persistent_state
-sub store_persistent_state {
- my($self) = @_;
- my $dir = $self->{build_dir};
- unless (File::Spec->canonpath(File::Basename::dirname($dir))
- eq File::Spec->canonpath($CPAN::Config->{build_dir})) {
- $CPAN::Frontend->mywarn("Directory '$dir' not below $CPAN::Config->{build_dir}, ".
- "will not store persistent state\n");
- return;
- }
- my $file = sprintf "%s.yml", $dir;
- my $yaml_module = CPAN::_yaml_module;
- if ($CPAN::META->has_inst($yaml_module)) {
- CPAN->_yaml_dumpfile(
- $file,
- {
- time => time,
- perl => CPAN::_perl_fingerprint,
- distribution => $self,
- }
- );
- } else {
- $CPAN::Frontend->myprint("Warning (usually harmless): '$yaml_module' not installed, ".
- "will not store persistent state\n");
- }
-}
-
-#-> CPAN::Distribution::try_download
-sub try_download {
- my($self,$patch) = @_;
- my $norm = $self->normalize($patch);
- my($local_wanted) =
- File::Spec->catfile(
- $CPAN::Config->{keep_source_where},
- "authors",
- "id",
- split(/\//,$norm),
- );
- $self->debug("Doing localize") if $CPAN::DEBUG;
- return CPAN::FTP->localize("authors/id/$norm",
- $local_wanted);
-}
-
-{
- my $stdpatchargs = "";
- #-> CPAN::Distribution::patch
- sub patch {
- my($self) = @_;
- $self->debug("checking patches id[$self->{ID}]") if $CPAN::DEBUG;
- my $patches = $self->prefs->{patches};
- $patches ||= "";
- $self->debug("patches[$patches]") if $CPAN::DEBUG;
- if ($patches) {
- return unless @$patches;
- $self->safe_chdir($self->{build_dir});
- CPAN->debug("patches[$patches]") if $CPAN::DEBUG;
- my $patchbin = $CPAN::Config->{patch};
- unless ($patchbin && length $patchbin) {
- $CPAN::Frontend->mydie("No external patch command configured\n\n".
- "Please run 'o conf init /patch/'\n\n");
- }
- unless (MM->maybe_command($patchbin)) {
- $CPAN::Frontend->mydie("No external patch command available\n\n".
- "Please run 'o conf init /patch/'\n\n");
- }
- $patchbin = CPAN::HandleConfig->safe_quote($patchbin);
- local $ENV{PATCH_GET} = 0; # formerly known as -g0
- unless ($stdpatchargs) {
- my $system = "$patchbin --version |";
- local *FH;
- open FH, $system or die "Could not fork '$system': $!";
- local $/ = "\n";
- my $pversion;
- PARSEVERSION: while (<FH>) {
- if (/^patch\s+([\d\.]+)/) {
- $pversion = $1;
- last PARSEVERSION;
- }
- }
- if ($pversion) {
- $stdpatchargs = "-N --fuzz=3";
- } else {
- $stdpatchargs = "-N";
- }
- }
- my $countedpatches = @$patches == 1 ? "1 patch" : (scalar @$patches . " patches");
- $CPAN::Frontend->myprint("Going to apply $countedpatches:\n");
- for my $patch (@$patches) {
- unless (-f $patch) {
- if (my $trydl = $self->try_download($patch)) {
- $patch = $trydl;
- } else {
- my $fail = "Could not find patch '$patch'";
- $CPAN::Frontend->mywarn("$fail; cannot continue\n");
- $self->{unwrapped} = CPAN::Distrostatus->new("NO -- $fail");
- delete $self->{build_dir};
- return;
- }
- }
- $CPAN::Frontend->myprint(" $patch\n");
- my $readfh = CPAN::Tarzip->TIEHANDLE($patch);
-
- my $pcommand;
- my $ppp = $self->_patch_p_parameter($readfh);
- if ($ppp eq "applypatch") {
- $pcommand = "$CPAN::Config->{applypatch} -verbose";
- } else {
- my $thispatchargs = join " ", $stdpatchargs, $ppp;
- $pcommand = "$patchbin $thispatchargs";
- }
-
- $readfh = CPAN::Tarzip->TIEHANDLE($patch); # open again
- my $writefh = FileHandle->new;
- $CPAN::Frontend->myprint(" $pcommand\n");
- unless (open $writefh, "|$pcommand") {
- my $fail = "Could not fork '$pcommand'";
- $CPAN::Frontend->mywarn("$fail; cannot continue\n");
- $self->{unwrapped} = CPAN::Distrostatus->new("NO -- $fail");
- delete $self->{build_dir};
- return;
- }
- while (my $x = $readfh->READLINE) {
- print $writefh $x;
- }
- unless (close $writefh) {
- my $fail = "Could not apply patch '$patch'";
- $CPAN::Frontend->mywarn("$fail; cannot continue\n");
- $self->{unwrapped} = CPAN::Distrostatus->new("NO -- $fail");
- delete $self->{build_dir};
- return;
- }
- }
- $self->{patched}++;
- }
- return 1;
- }
-}
-
-sub _patch_p_parameter {
- my($self,$fh) = @_;
- my $cnt_files = 0;
- my $cnt_p0files = 0;
- local($_);
- while ($_ = $fh->READLINE) {
- if (
- $CPAN::Config->{applypatch}
- &&
- /\#\#\#\# ApplyPatch data follows \#\#\#\#/
- ) {
- return "applypatch"
- }
- next unless /^[\*\+]{3}\s(\S+)/;
- my $file = $1;
- $cnt_files++;
- $cnt_p0files++ if -f $file;
- CPAN->debug("file[$file]cnt_files[$cnt_files]cnt_p0files[$cnt_p0files]")
- if $CPAN::DEBUG;
- }
- return "-p1" unless $cnt_files;
- return $cnt_files==$cnt_p0files ? "-p0" : "-p1";
-}
-
-#-> sub CPAN::Distribution::_edge_cases
-# with "configure" or "Makefile" or single file scripts
-sub _edge_cases {
- my($self,$mpl,$local_file) = @_;
- $self->debug(sprintf("makefilepl[%s]anycwd[%s]",
- $mpl,
- CPAN::anycwd(),
- )) if $CPAN::DEBUG;
- my $build_dir = $self->{build_dir};
- my($configure) = File::Spec->catfile($build_dir,"Configure");
- if (-f $configure) {
- # do we have anything to do?
- $self->{configure} = $configure;
- } elsif (-f File::Spec->catfile($build_dir,"Makefile")) {
- $CPAN::Frontend->mywarn(qq{
-Package comes with a Makefile and without a Makefile.PL.
-We\'ll try to build it with that Makefile then.
-});
- $self->{writemakefile} = CPAN::Distrostatus->new("YES");
- $CPAN::Frontend->mysleep(2);
- } else {
- my $cf = $self->called_for || "unknown";
- if ($cf =~ m|/|) {
- $cf =~ s|.*/||;
- $cf =~ s|\W.*||;
- }
- $cf =~ s|[/\\:]||g; # risk of filesystem damage
- $cf = "unknown" unless length($cf);
- $CPAN::Frontend->mywarn(qq{Package seems to come without Makefile.PL.
- (The test -f "$mpl" returned false.)
- Writing one on our own (setting NAME to $cf)\a\n});
- $self->{had_no_makefile_pl}++;
- $CPAN::Frontend->mysleep(3);
-
- # Writing our own Makefile.PL
-
- my $script = "";
- if ($self->{archived} eq "maybe_pl") {
- my $fh = FileHandle->new;
- my $script_file = File::Spec->catfile($build_dir,$local_file);
- $fh->open($script_file)
- or Carp::croak("Could not open script '$script_file': $!");
- local $/ = "\n";
- # name parsen und prereq
- my($state) = "poddir";
- my($name, $prereq) = ("", "");
- while (<$fh>) {
- if ($state eq "poddir" && /^=head\d\s+(\S+)/) {
- if ($1 eq 'NAME') {
- $state = "name";
- } elsif ($1 eq 'PREREQUISITES') {
- $state = "prereq";
- }
- } elsif ($state =~ m{^(name|prereq)$}) {
- if (/^=/) {
- $state = "poddir";
- } elsif (/^\s*$/) {
- # nop
- } elsif ($state eq "name") {
- if ($name eq "") {
- ($name) = /^(\S+)/;
- $state = "poddir";
- }
- } elsif ($state eq "prereq") {
- $prereq .= $_;
- }
- } elsif (/^=cut\b/) {
- last;
- }
- }
- $fh->close;
-
- for ($name) {
- s{.*<}{}; # strip X<...>
- s{>.*}{};
- }
- chomp $prereq;
- $prereq = join " ", split /\s+/, $prereq;
- my($PREREQ_PM) = join("\n", map {
- s{.*<}{}; # strip X<...>
- s{>.*}{};
- if (/[\s\'\"]/) { # prose?
- } else {
- s/[^\w:]$//; # period?
- " "x28 . "'$_' => 0,";
- }
- } split /\s*,\s*/, $prereq);
-
- $script = "
- EXE_FILES => ['$name'],
- PREREQ_PM => {
-$PREREQ_PM
- },
-";
- if ($name) {
- my $to_file = File::Spec->catfile($build_dir, $name);
- rename $script_file, $to_file
- or die "Can't rename $script_file to $to_file: $!";
- }
- }
-
- my $fh = FileHandle->new;
- $fh->open(">$mpl")
- or Carp::croak("Could not open >$mpl: $!");
- $fh->print(
- qq{# This Makefile.PL has been autogenerated by the module CPAN.pm
-# because there was no Makefile.PL supplied.
-# Autogenerated on: }.scalar localtime().qq{
-
-use ExtUtils::MakeMaker;
-WriteMakefile(
- NAME => q[$cf],$script
- );
-});
- $fh->close;
- }
-}
-
-#-> CPAN::Distribution::_signature_business
-sub _signature_business {
- my($self) = @_;
- my $check_sigs = CPAN::HandleConfig->prefs_lookup($self,
- q{check_sigs});
- if ($check_sigs) {
- if ($CPAN::META->has_inst("Module::Signature")) {
- if (-f "SIGNATURE") {
- $self->debug("Module::Signature is installed, verifying") if $CPAN::DEBUG;
- my $rv = Module::Signature::verify();
- if ($rv != Module::Signature::SIGNATURE_OK() and
- $rv != Module::Signature::SIGNATURE_MISSING()) {
- $CPAN::Frontend->mywarn(
- qq{\nSignature invalid for }.
- qq{distribution file. }.
- qq{Please investigate.\n\n}
- );
-
- my $wrap =
- sprintf(qq{I'd recommend removing %s. Some error occured }.
- qq{while checking its signature, so it could }.
- qq{be invalid. Maybe you have configured }.
- qq{your 'urllist' with a bad URL. Please check this }.
- qq{array with 'o conf urllist' and retry. Or }.
- qq{examine the distribution in a subshell. Try
- look %s
-and run
- cpansign -v
-},
- $self->{localfile},
- $self->pretty_id,
- );
- $self->{signature_verify} = CPAN::Distrostatus->new("NO");
- $CPAN::Frontend->mywarn(Text::Wrap::wrap("","",$wrap));
- $CPAN::Frontend->mysleep(5) if $CPAN::Frontend->can("mysleep");
- } else {
- $self->{signature_verify} = CPAN::Distrostatus->new("YES");
- $self->debug("Module::Signature has verified") if $CPAN::DEBUG;
- }
- } else {
- $CPAN::Frontend->mywarn(qq{Package came without SIGNATURE\n\n});
- }
- } else {
- $self->debug("Module::Signature is NOT installed") if $CPAN::DEBUG;
- }
- }
-}
-
-#-> CPAN::Distribution::untar_me ;
-sub untar_me {
- my($self,$ct) = @_;
- $self->{archived} = "tar";
- if ($ct->untar()) {
- $self->{unwrapped} = CPAN::Distrostatus->new("YES");
- } else {
- $self->{unwrapped} = CPAN::Distrostatus->new("NO -- untar failed");
- }
-}
-
-# CPAN::Distribution::unzip_me ;
-sub unzip_me {
- my($self,$ct) = @_;
- $self->{archived} = "zip";
- if ($ct->unzip()) {
- $self->{unwrapped} = CPAN::Distrostatus->new("YES");
- } else {
- $self->{unwrapped} = CPAN::Distrostatus->new("NO -- unzip failed");
- }
- return;
-}
-
-sub handle_singlefile {
- my($self,$local_file) = @_;
-
- if ( $local_file =~ /\.pm(\.(gz|Z))?(?!\n)\Z/ ) {
- $self->{archived} = "pm";
- } elsif ( $local_file =~ /\.patch(\.(gz|bz2))?(?!\n)\Z/ ) {
- $self->{archived} = "patch";
- } else {
- $self->{archived} = "maybe_pl";
- }
-
- my $to = File::Basename::basename($local_file);
- if ($to =~ s/\.(gz|Z)(?!\n)\Z//) {
- if (eval{CPAN::Tarzip->new($local_file)->gunzip($to)}) {
- $self->{unwrapped} = CPAN::Distrostatus->new("YES");
- } else {
- $self->{unwrapped} = CPAN::Distrostatus->new("NO -- uncompressing failed");
- }
- } else {
- if (File::Copy::cp($local_file,".")) {
- $self->{unwrapped} = CPAN::Distrostatus->new("YES");
- } else {
- $self->{unwrapped} = CPAN::Distrostatus->new("NO -- copying failed");
- }
- }
- return $to;
-}
-
-#-> sub CPAN::Distribution::new ;
-sub new {
- my($class,%att) = @_;
-
- # $CPAN::META->{cachemgr} ||= CPAN::CacheMgr->new();
-
- my $this = { %att };
- return bless $this, $class;
-}
-
-#-> sub CPAN::Distribution::look ;
-sub look {
- my($self) = @_;
-
- if ($^O eq 'MacOS') {
- $self->Mac::BuildTools::look;
- return;
- }
-
- if ( $CPAN::Config->{'shell'} ) {
- $CPAN::Frontend->myprint(qq{
-Trying to open a subshell in the build directory...
-});
- } else {
- $CPAN::Frontend->myprint(qq{
-Your configuration does not define a value for subshells.
-Please define it with "o conf shell <your shell>"
-});
- return;
- }
- my $dist = $self->id;
- my $dir;
- unless ($dir = $self->dir) {
- $self->get;
- }
- unless ($dir ||= $self->dir) {
- $CPAN::Frontend->mywarn(qq{
-Could not determine which directory to use for looking at $dist.
-});
- return;
- }
- my $pwd = CPAN::anycwd();
- $self->safe_chdir($dir);
- $CPAN::Frontend->myprint(qq{Working directory is $dir\n});
- {
- local $ENV{CPAN_SHELL_LEVEL} = $ENV{CPAN_SHELL_LEVEL}||0;
- $ENV{CPAN_SHELL_LEVEL} += 1;
- my $shell = CPAN::HandleConfig->safe_quote($CPAN::Config->{'shell'});
- unless (system($shell) == 0) {
- my $code = $? >> 8;
- $CPAN::Frontend->mywarn("Subprocess shell exit code $code\n");
- }
- }
- $self->safe_chdir($pwd);
-}
-
-# CPAN::Distribution::cvs_import ;
-sub cvs_import {
- my($self) = @_;
- $self->get;
- my $dir = $self->dir;
-
- my $package = $self->called_for;
- my $module = $CPAN::META->instance('CPAN::Module', $package);
- my $version = $module->cpan_version;
-
- my $userid = $self->cpan_userid;
-
- my $cvs_dir = (split /\//, $dir)[-1];
- $cvs_dir =~ s/-\d+[^-]+(?!\n)\Z//;
- my $cvs_root =
- $CPAN::Config->{cvsroot} || $ENV{CVSROOT};
- my $cvs_site_perl =
- $CPAN::Config->{cvs_site_perl} || $ENV{CVS_SITE_PERL};
- if ($cvs_site_perl) {
- $cvs_dir = "$cvs_site_perl/$cvs_dir";
- }
- my $cvs_log = qq{"imported $package $version sources"};
- $version =~ s/\./_/g;
- # XXX cvs: undocumented and unclear how it was meant to work
- my @cmd = ('cvs', '-d', $cvs_root, 'import', '-m', $cvs_log,
- "$cvs_dir", $userid, "v$version");
-
- my $pwd = CPAN::anycwd();
- chdir($dir) or $CPAN::Frontend->mydie(qq{Could not chdir to "$dir": $!});
-
- $CPAN::Frontend->myprint(qq{Working directory is $dir\n});
-
- $CPAN::Frontend->myprint(qq{@cmd\n});
- system(@cmd) == 0 or
- # XXX cvs
- $CPAN::Frontend->mydie("cvs import failed");
- chdir($pwd) or $CPAN::Frontend->mydie(qq{Could not chdir to "$pwd": $!});
-}
-
-#-> sub CPAN::Distribution::readme ;
-sub readme {
- my($self) = @_;
- my($dist) = $self->id;
- my($sans,$suffix) = $dist =~ /(.+)\.(tgz|tar[\._-]gz|tar\.Z|zip)$/;
- $self->debug("sans[$sans] suffix[$suffix]\n") if $CPAN::DEBUG;
- my($local_file);
- my($local_wanted) =
- File::Spec->catfile(
- $CPAN::Config->{keep_source_where},
- "authors",
- "id",
- split(/\//,"$sans.readme"),
- );
- $self->debug("Doing localize") if $CPAN::DEBUG;
- $local_file = CPAN::FTP->localize("authors/id/$sans.readme",
- $local_wanted)
- or $CPAN::Frontend->mydie(qq{No $sans.readme found});;
-
- if ($^O eq 'MacOS') {
- Mac::BuildTools::launch_file($local_file);
- return;
- }
-
- my $fh_pager = FileHandle->new;
- local($SIG{PIPE}) = "IGNORE";
- my $pager = $CPAN::Config->{'pager'} || "cat";
- $fh_pager->open("|$pager")
- or die "Could not open pager $pager\: $!";
- my $fh_readme = FileHandle->new;
- $fh_readme->open($local_file)
- or $CPAN::Frontend->mydie(qq{Could not open "$local_file": $!});
- $CPAN::Frontend->myprint(qq{
-Displaying file
- $local_file
-with pager "$pager"
-});
- $fh_pager->print(<$fh_readme>);
- $fh_pager->close;
-}
-
-#-> sub CPAN::Distribution::verifyCHECKSUM ;
-sub verifyCHECKSUM {
- my($self) = @_;
- EXCUSE: {
- my @e;
- $self->{CHECKSUM_STATUS} ||= "";
- $self->{CHECKSUM_STATUS} eq "OK" and push @e, "Checksum was ok";
- $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
- }
- my($lc_want,$lc_file,@local,$basename);
- @local = split(/\//,$self->id);
- pop @local;
- push @local, "CHECKSUMS";
- $lc_want =
- File::Spec->catfile($CPAN::Config->{keep_source_where},
- "authors", "id", @local);
- local($") = "/";
- if (my $size = -s $lc_want) {
- $self->debug("lc_want[$lc_want]size[$size]") if $CPAN::DEBUG;
- if ($self->CHECKSUM_check_file($lc_want,1)) {
- return $self->{CHECKSUM_STATUS} = "OK";
- }
- }
- $lc_file = CPAN::FTP->localize("authors/id/@local",
- $lc_want,1);
- unless ($lc_file) {
- $CPAN::Frontend->myprint("Trying $lc_want.gz\n");
- $local[-1] .= ".gz";
- $lc_file = CPAN::FTP->localize("authors/id/@local",
- "$lc_want.gz",1);
- if ($lc_file) {
- $lc_file =~ s/\.gz(?!\n)\Z//;
- eval{CPAN::Tarzip->new("$lc_file.gz")->gunzip($lc_file)};
- } else {
- return;
- }
- }
- if ($self->CHECKSUM_check_file($lc_file)) {
- return $self->{CHECKSUM_STATUS} = "OK";
- }
-}
-
-#-> sub CPAN::Distribution::SIG_check_file ;
-sub SIG_check_file {
- my($self,$chk_file) = @_;
- my $rv = eval { Module::Signature::_verify($chk_file) };
-
- if ($rv == Module::Signature::SIGNATURE_OK()) {
- $CPAN::Frontend->myprint("Signature for $chk_file ok\n");
- return $self->{SIG_STATUS} = "OK";
- } else {
- $CPAN::Frontend->myprint(qq{\nSignature invalid for }.
- qq{distribution file. }.
- qq{Please investigate.\n\n}.
- $self->as_string,
- $CPAN::META->instance(
- 'CPAN::Author',
- $self->cpan_userid
- )->as_string);
-
- my $wrap = qq{I\'d recommend removing $chk_file. Its signature
-is invalid. Maybe you have configured your 'urllist' with
-a bad URL. Please check this array with 'o conf urllist', and
-retry.};
-
- $CPAN::Frontend->mydie(Text::Wrap::wrap("","",$wrap));
- }
-}
-
-#-> sub CPAN::Distribution::CHECKSUM_check_file ;
-
-# sloppy is 1 when we have an old checksums file that maybe is good
-# enough
-
-sub CHECKSUM_check_file {
- my($self,$chk_file,$sloppy) = @_;
- my($cksum,$file,$basename);
-
- $sloppy ||= 0;
- $self->debug("chk_file[$chk_file]sloppy[$sloppy]") if $CPAN::DEBUG;
- my $check_sigs = CPAN::HandleConfig->prefs_lookup($self,
- q{check_sigs});
- if ($check_sigs) {
- if ($CPAN::META->has_inst("Module::Signature")) {
- $self->debug("Module::Signature is installed, verifying") if $CPAN::DEBUG;
- $self->SIG_check_file($chk_file);
- } else {
- $self->debug("Module::Signature is NOT installed") if $CPAN::DEBUG;
- }
- }
-
- $file = $self->{localfile};
- $basename = File::Basename::basename($file);
- my $fh = FileHandle->new;
- if (open $fh, $chk_file) {
- local($/);
- my $eval = <$fh>;
- $eval =~ s/\015?\012/\n/g;
- close $fh;
- my($comp) = Safe->new();
- $cksum = $comp->reval($eval);
- if ($@) {
- rename $chk_file, "$chk_file.bad";
- Carp::confess($@) if $@;
- }
- } else {
- Carp::carp "Could not open $chk_file for reading";
- }
-
- if (! ref $cksum or ref $cksum ne "HASH") {
- $CPAN::Frontend->mywarn(qq{
-Warning: checksum file '$chk_file' broken.
-
-When trying to read that file I expected to get a hash reference
-for further processing, but got garbage instead.
-});
- my $answer = CPAN::Shell::colorable_makemaker_prompt("Proceed nonetheless?", "no");
- $answer =~ /^\s*y/i or $CPAN::Frontend->mydie("Aborted.\n");
- $self->{CHECKSUM_STATUS} = "NIL -- CHECKSUMS file broken";
- return;
- } elsif (exists $cksum->{$basename}{sha256}) {
- $self->debug("Found checksum for $basename:" .
- "$cksum->{$basename}{sha256}\n") if $CPAN::DEBUG;
-
- open($fh, $file);
- binmode $fh;
- my $eq = $self->eq_CHECKSUM($fh,$cksum->{$basename}{sha256});
- $fh->close;
- $fh = CPAN::Tarzip->TIEHANDLE($file);
-
- unless ($eq) {
- my $dg = Digest::SHA->new(256);
- my($data,$ref);
- $ref = \$data;
- while ($fh->READ($ref, 4096) > 0) {
- $dg->add($data);
- }
- my $hexdigest = $dg->hexdigest;
- $eq += $hexdigest eq $cksum->{$basename}{'sha256-ungz'};
- }
-
- if ($eq) {
- $CPAN::Frontend->myprint("Checksum for $file ok\n");
- return $self->{CHECKSUM_STATUS} = "OK";
- } else {
- $CPAN::Frontend->myprint(qq{\nChecksum mismatch for }.
- qq{distribution file. }.
- qq{Please investigate.\n\n}.
- $self->as_string,
- $CPAN::META->instance(
- 'CPAN::Author',
- $self->cpan_userid
- )->as_string);
-
- my $wrap = qq{I\'d recommend removing $file. Its
-checksum is incorrect. Maybe you have configured your 'urllist' with
-a bad URL. Please check this array with 'o conf urllist', and
-retry.};
-
- $CPAN::Frontend->mydie(Text::Wrap::wrap("","",$wrap));
-
- # former versions just returned here but this seems a
- # serious threat that deserves a die
-
- # $CPAN::Frontend->myprint("\n\n");
- # sleep 3;
- # return;
- }
- # close $fh if fileno($fh);
- } else {
- return if $sloppy;
- unless ($self->{CHECKSUM_STATUS}) {
- $CPAN::Frontend->mywarn(qq{
-Warning: No checksum for $basename in $chk_file.
-
-The cause for this may be that the file is very new and the checksum
-has not yet been calculated, but it may also be that something is
-going awry right now.
-});
- my $answer = CPAN::Shell::colorable_makemaker_prompt("Proceed?", "yes");
- $answer =~ /^\s*y/i or $CPAN::Frontend->mydie("Aborted.\n");
- }
- $self->{CHECKSUM_STATUS} = "NIL -- distro not in CHECKSUMS file";
- return;
- }
-}
-
-#-> sub CPAN::Distribution::eq_CHECKSUM ;
-sub eq_CHECKSUM {
- my($self,$fh,$expect) = @_;
- if ($CPAN::META->has_inst("Digest::SHA")) {
- my $dg = Digest::SHA->new(256);
- my($data);
- while (read($fh, $data, 4096)) {
- $dg->add($data);
- }
- my $hexdigest = $dg->hexdigest;
- # warn "fh[$fh] hex[$hexdigest] aexp[$expectMD5]";
- return $hexdigest eq $expect;
- }
- return 1;
-}
-
-#-> sub CPAN::Distribution::force ;
-
-# Both CPAN::Modules and CPAN::Distributions know if "force" is in
-# effect by autoinspection, not by inspecting a global variable. One
-# of the reason why this was chosen to work that way was the treatment
-# of dependencies. They should not automatically inherit the force
-# status. But this has the downside that ^C and die() will return to
-# the prompt but will not be able to reset the force_update
-# attributes. We try to correct for it currently in the read_metadata
-# routine, and immediately before we check for a Signal. I hope this
-# works out in one of v1.57_53ff
-
-# "Force get forgets previous error conditions"
-
-#-> sub CPAN::Distribution::fforce ;
-sub fforce {
- my($self, $method) = @_;
- $self->force($method,1);
-}
-
-#-> sub CPAN::Distribution::force ;
-sub force {
- my($self, $method,$fforce) = @_;
- my %phase_map = (
- get => [
- "unwrapped",
- "build_dir",
- "archived",
- "localfile",
- "CHECKSUM_STATUS",
- "signature_verify",
- "prefs",
- "prefs_file",
- "prefs_file_doc",
- ],
- make => [
- "writemakefile",
- "make",
- "modulebuild",
- "prereq_pm",
- "prereq_pm_detected",
- ],
- test => [
- "badtestcnt",
- "make_test",
- ],
- install => [
- "install",
- ],
- unknown => [
- "reqtype",
- "yaml_content",
- ],
- );
- my $methodmatch = 0;
- my $ldebug = 0;
- PHASE: for my $phase (qw(unknown get make test install)) { # order matters
- $methodmatch = 1 if $fforce || $phase eq $method;
- next unless $methodmatch;
- ATTRIBUTE: for my $att (@{$phase_map{$phase}}) {
- if ($phase eq "get") {
- if (substr($self->id,-1,1) eq "."
- && $att =~ /(unwrapped|build_dir|archived)/ ) {
- # cannot be undone for local distros
- next ATTRIBUTE;
- }
- if ($att eq "build_dir"
- && $self->{build_dir}
- && $CPAN::META->{is_tested}
- ) {
- delete $CPAN::META->{is_tested}{$self->{build_dir}};
- }
- } elsif ($phase eq "test") {
- if ($att eq "make_test"
- && $self->{make_test}
- && $self->{make_test}{COMMANDID}
- && $self->{make_test}{COMMANDID} == $CPAN::CurrentCommandId
- ) {
- # endless loop too likely
- next ATTRIBUTE;
- }
- }
- delete $self->{$att};
- if ($ldebug || $CPAN::DEBUG) {
- # local $CPAN::DEBUG = 16; # Distribution
- CPAN->debug(sprintf "id[%s]phase[%s]att[%s]", $self->id, $phase, $att);
- }
- }
- }
- if ($method && $method =~ /make|test|install/) {
- $self->{force_update} = 1; # name should probably have been force_install
- }
-}
-
-#-> sub CPAN::Distribution::notest ;
-sub notest {
- my($self, $method) = @_;
- # $CPAN::Frontend->mywarn("XDEBUG: set notest for $self $method");
- $self->{"notest"}++; # name should probably have been force_install
-}
-
-#-> sub CPAN::Distribution::unnotest ;
-sub unnotest {
- my($self) = @_;
- # warn "XDEBUG: deleting notest";
- delete $self->{notest};
-}
-
-#-> sub CPAN::Distribution::unforce ;
-sub unforce {
- my($self) = @_;
- delete $self->{force_update};
-}
-
-#-> sub CPAN::Distribution::isa_perl ;
-sub isa_perl {
- my($self) = @_;
- my $file = File::Basename::basename($self->id);
- if ($file =~ m{ ^ perl
- -?
- (5)
- ([._-])
- (
- \d{3}(_[0-4][0-9])?
- |
- \d+\.\d+
- )
- \.tar[._-](?:gz|bz2)
- (?!\n)\Z
- }xs) {
- return "$1.$3";
- } elsif ($self->cpan_comment
- &&
- $self->cpan_comment =~ /isa_perl\(.+?\)/) {
- return $1;
- }
-}
-
-
-#-> sub CPAN::Distribution::perl ;
-sub perl {
- my ($self) = @_;
- if (! $self) {
- use Carp qw(carp);
- carp __PACKAGE__ . "::perl was called without parameters.";
- }
- return CPAN::HandleConfig->safe_quote($CPAN::Perl);
-}
-
-
-#-> sub CPAN::Distribution::make ;
-sub make {
- my($self) = @_;
- if (my $goto = $self->prefs->{goto}) {
- return $self->goto($goto);
- }
- my $make = $self->{modulebuild} ? "Build" : "make";
- # Emergency brake if they said install Pippi and get newest perl
- if ($self->isa_perl) {
- if (
- $self->called_for ne $self->id &&
- ! $self->{force_update}
- ) {
- # if we die here, we break bundles
- $CPAN::Frontend
- ->mywarn(sprintf(
- qq{The most recent version "%s" of the module "%s"
-is part of the perl-%s distribution. To install that, you need to run
- force install %s --or--
- install %s
-},
- $CPAN::META->instance(
- 'CPAN::Module',
- $self->called_for
- )->cpan_version,
- $self->called_for,
- $self->isa_perl,
- $self->called_for,
- $self->id,
- ));
- $self->{make} = CPAN::Distrostatus->new("NO isa perl");
- $CPAN::Frontend->mysleep(1);
- return;
- }
- }
- $CPAN::Frontend->myprint(sprintf "Running %s for %s\n", $make, $self->id);
- $self->get;
- if ($self->{configure_requires_later}) {
- return;
- }
- local $ENV{PERL5LIB} = defined($ENV{PERL5LIB})
- ? $ENV{PERL5LIB}
- : ($ENV{PERLLIB} || "");
- $CPAN::META->set_perl5lib;
- local $ENV{MAKEFLAGS}; # protect us from outer make calls
-
- if ($CPAN::Signal) {
- delete $self->{force_update};
- return;
- }
-
- my $builddir;
- EXCUSE: {
- my @e;
- if (!$self->{archived} || $self->{archived} eq "NO") {
- push @e, "Is neither a tar nor a zip archive.";
- }
-
- if (!$self->{unwrapped}
- || (
- UNIVERSAL::can($self->{unwrapped},"failed") ?
- $self->{unwrapped}->failed :
- $self->{unwrapped} =~ /^NO/
- )) {
- push @e, "Had problems unarchiving. Please build manually";
- }
-
- unless ($self->{force_update}) {
- exists $self->{signature_verify} and
- (
- UNIVERSAL::can($self->{signature_verify},"failed") ?
- $self->{signature_verify}->failed :
- $self->{signature_verify} =~ /^NO/
- )
- and push @e, "Did not pass the signature test.";
- }
-
- if (exists $self->{writemakefile} &&
- (
- UNIVERSAL::can($self->{writemakefile},"failed") ?
- $self->{writemakefile}->failed :
- $self->{writemakefile} =~ /^NO/
- )) {
- # XXX maybe a retry would be in order?
- my $err = UNIVERSAL::can($self->{writemakefile},"text") ?
- $self->{writemakefile}->text :
- $self->{writemakefile};
- $err =~ s/^NO\s*//;
- $err ||= "Had some problem writing Makefile";
- $err .= ", won't make";
- push @e, $err;
- }
-
- if (defined $self->{make}) {
- if (UNIVERSAL::can($self->{make},"failed") ?
- $self->{make}->failed :
- $self->{make} =~ /^NO/) {
- if ($self->{force_update}) {
- # Trying an already failed 'make' (unless somebody else blocks)
- } else {
- # introduced for turning recursion detection into a distrostatus
- my $error = length $self->{make}>3
- ? substr($self->{make},3) : "Unknown error";
- $CPAN::Frontend->mywarn("Could not make: $error\n");
- $self->store_persistent_state;
- return;
- }
- } else {
- push @e, "Has already been made";
- }
- }
-
- my $later = $self->{later} || $self->{configure_requires_later};
- if ($later) { # see also undelay
- if ($later) {
- push @e, $later;
- }
- }
-
- $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
- $builddir = $self->dir or
- $CPAN::Frontend->mydie("PANIC: Cannot determine build directory\n");
- unless (chdir $builddir) {
- push @e, "Couldn't chdir to '$builddir': $!";
- }
- $CPAN::Frontend->mywarn(join "", map {" $_\n"} @e) and return if @e;
- }
- if ($CPAN::Signal) {
- delete $self->{force_update};
- return;
- }
- $CPAN::Frontend->myprint("\n CPAN.pm: Going to build ".$self->id."\n\n");
- $self->debug("Changed directory to $builddir") if $CPAN::DEBUG;
-
- if ($^O eq 'MacOS') {
- Mac::BuildTools::make($self);
- return;
- }
-
- my %env;
- while (my($k,$v) = each %ENV) {
- next unless defined $v;
- $env{$k} = $v;
- }
- local %ENV = %env;
- my $system;
- if (my $commandline = $self->prefs->{pl}{commandline}) {
- $system = $commandline;
- $ENV{PERL} = $^X;
- } elsif ($self->{'configure'}) {
- $system = $self->{'configure'};
- } elsif ($self->{modulebuild}) {
- my($perl) = $self->perl or die "Couldn\'t find executable perl\n";
- $system = "$perl Build.PL $CPAN::Config->{mbuildpl_arg}";
- } else {
- my($perl) = $self->perl or die "Couldn\'t find executable perl\n";
- my $switch = "";
-# This needs a handler that can be turned on or off:
-# $switch = "-MExtUtils::MakeMaker ".
-# "-Mops=:default,:filesys_read,:filesys_open,require,chdir"
-# if $] > 5.00310;
- my $makepl_arg = $self->make_x_arg("pl");
- $ENV{PERL5_CPAN_IS_EXECUTING} = File::Spec->catfile($self->{build_dir},
- "Makefile.PL");
- $system = sprintf("%s%s Makefile.PL%s",
- $perl,
- $switch ? " $switch" : "",
- $makepl_arg ? " $makepl_arg" : "",
- );
- }
- if (my $env = $self->prefs->{pl}{env}) {
- for my $e (keys %$env) {
- $ENV{$e} = $env->{$e};
- }
- }
- if (exists $self->{writemakefile}) {
- } else {
- local($SIG{ALRM}) = sub { die "inactivity_timeout reached\n" };
- my($ret,$pid,$output);
- $@ = "";
- my $go_via_alarm;
- if ($CPAN::Config->{inactivity_timeout}) {
- require Config;
- if ($Config::Config{d_alarm}
- &&
- $Config::Config{d_alarm} eq "define"
- ) {
- $go_via_alarm++
- } else {
- $CPAN::Frontend->mywarn("Warning: you have configured the config ".
- "variable 'inactivity_timeout' to ".
- "'$CPAN::Config->{inactivity_timeout}'. But ".
- "on this machine the system call 'alarm' ".
- "isn't available. This means that we cannot ".
- "provide the feature of intercepting long ".
- "waiting code and will turn this feature off.\n"
- );
- $CPAN::Config->{inactivity_timeout} = 0;
- }
- }
- if ($go_via_alarm) {
- if ( $self->_should_report('pl') ) {
- ($output, $ret) = CPAN::Reporter::record_command(
- $system,
- $CPAN::Config->{inactivity_timeout},
- );
- CPAN::Reporter::grade_PL( $self, $system, $output, $ret );
- }
- else {
- eval {
- alarm $CPAN::Config->{inactivity_timeout};
- local $SIG{CHLD}; # = sub { wait };
- if (defined($pid = fork)) {
- if ($pid) { #parent
- # wait;
- waitpid $pid, 0;
- } else { #child
- # note, this exec isn't necessary if
- # inactivity_timeout is 0. On the Mac I'd
- # suggest, we set it always to 0.
- exec $system;
- }
- } else {
- $CPAN::Frontend->myprint("Cannot fork: $!");
- return;
- }
- };
- alarm 0;
- if ($@) {
- kill 9, $pid;
- waitpid $pid, 0;
- my $err = "$@";
- $CPAN::Frontend->myprint($err);
- $self->{writemakefile} = CPAN::Distrostatus->new("NO $err");
- $@ = "";
- $self->store_persistent_state;
- return $self->goodbye("$system -- TIMED OUT");
- }
- }
- } else {
- if (my $expect_model = $self->_prefs_with_expect("pl")) {
- # XXX probably want to check _should_report here and warn
- # about not being able to use CPAN::Reporter with expect
- $ret = $self->_run_via_expect($system,$expect_model);
- if (! defined $ret
- && $self->{writemakefile}
- && $self->{writemakefile}->failed) {
- # timeout
- return;
- }
- }
- elsif ( $self->_should_report('pl') ) {
- ($output, $ret) = CPAN::Reporter::record_command($system);
- CPAN::Reporter::grade_PL( $self, $system, $output, $ret );
- }
- else {
- $ret = system($system);
- }
- if ($ret != 0) {
- $self->{writemakefile} = CPAN::Distrostatus
- ->new("NO '$system' returned status $ret");
- $CPAN::Frontend->mywarn("Warning: No success on command[$system]\n");
- $self->store_persistent_state;
- return $self->goodbye("$system -- NOT OK");
- }
- }
- if (-f "Makefile" || -f "Build") {
- $self->{writemakefile} = CPAN::Distrostatus->new("YES");
- delete $self->{make_clean}; # if cleaned before, enable next
- } else {
- my $makefile = $self->{modulebuild} ? "Build" : "Makefile";
- $self->{writemakefile} = CPAN::Distrostatus
- ->new(qq{NO -- No $makefile created});
- $self->store_persistent_state;
- return $self->goodbye("$system -- NO $makefile created");
- }
- }
- if ($CPAN::Signal) {
- delete $self->{force_update};
- return;
- }
- if (my @prereq = $self->unsat_prereq("later")) {
- if ($prereq[0][0] eq "perl") {
- my $need = "requires perl '$prereq[0][1]'";
- my $id = $self->pretty_id;
- $CPAN::Frontend->mywarn("$id $need; you have only $]; giving up\n");
- $self->{make} = CPAN::Distrostatus->new("NO $need");
- $self->store_persistent_state;
- return $self->goodbye("[prereq] -- NOT OK");
- } else {
- my $follow = eval { $self->follow_prereqs("later",@prereq); };
- if (0) {
- } elsif ($follow) {
- # signal success to the queuerunner
- return 1;
- } elsif ($@ && ref $@ && $@->isa("CPAN::Exception::RecursiveDependency")) {
- $CPAN::Frontend->mywarn($@);
- return $self->goodbye("[depend] -- NOT OK");
- }
- }
- }
- if ($CPAN::Signal) {
- delete $self->{force_update};
- return;
- }
- if (my $commandline = $self->prefs->{make}{commandline}) {
- $system = $commandline;
- $ENV{PERL} = CPAN::find_perl;
- } else {
- if ($self->{modulebuild}) {
- unless (-f "Build") {
- my $cwd = CPAN::anycwd();
- $CPAN::Frontend->mywarn("Alert: no Build file available for 'make $self->{id}'".
- " in cwd[$cwd]. Danger, Will Robinson!\n");
- $CPAN::Frontend->mysleep(5);
- }
- $system = join " ", $self->_build_command(), $CPAN::Config->{mbuild_arg};
- } else {
- $system = join " ", $self->_make_command(), $CPAN::Config->{make_arg};
- }
- $system =~ s/\s+$//;
- my $make_arg = $self->make_x_arg("make");
- $system = sprintf("%s%s",
- $system,
- $make_arg ? " $make_arg" : "",
- );
- }
- if (my $env = $self->prefs->{make}{env}) { # overriding the local
- # ENV of PL, not the
- # outer ENV, but
- # unlikely to be a risk
- for my $e (keys %$env) {
- $ENV{$e} = $env->{$e};
- }
- }
- my $expect_model = $self->_prefs_with_expect("make");
- my $want_expect = 0;
- if ( $expect_model && @{$expect_model->{talk}} ) {
- my $can_expect = $CPAN::META->has_inst("Expect");
- if ($can_expect) {
- $want_expect = 1;
- } else {
- $CPAN::Frontend->mywarn("Expect not installed, falling back to ".
- "system()\n");
- }
- }
- my $system_ok;
- if ($want_expect) {
- # XXX probably want to check _should_report here and
- # warn about not being able to use CPAN::Reporter with expect
- $system_ok = $self->_run_via_expect($system,$expect_model) == 0;
- }
- elsif ( $self->_should_report('make') ) {
- my ($output, $ret) = CPAN::Reporter::record_command($system);
- CPAN::Reporter::grade_make( $self, $system, $output, $ret );
- $system_ok = ! $ret;
- }
- else {
- $system_ok = system($system) == 0;
- }
- $self->introduce_myself;
- if ( $system_ok ) {
- $CPAN::Frontend->myprint(" $system -- OK\n");
- $self->{make} = CPAN::Distrostatus->new("YES");
- } else {
- $self->{writemakefile} ||= CPAN::Distrostatus->new("YES");
- $self->{make} = CPAN::Distrostatus->new("NO");
- $CPAN::Frontend->mywarn(" $system -- NOT OK\n");
- }
- $self->store_persistent_state;
-}
-
-# CPAN::Distribution::goodbye ;
-sub goodbye {
- my($self,$goodbye) = @_;
- my $id = $self->pretty_id;
- $CPAN::Frontend->mywarn(" $id\n $goodbye\n");
- return;
-}
-
-# CPAN::Distribution::_run_via_expect ;
-sub _run_via_expect {
- my($self,$system,$expect_model) = @_;
- CPAN->debug("system[$system]expect_model[$expect_model]") if $CPAN::DEBUG;
- if ($CPAN::META->has_inst("Expect")) {
- my $expo = Expect->new; # expo Expect object;
- $expo->spawn($system);
- $expect_model->{mode} ||= "deterministic";
- if ($expect_model->{mode} eq "deterministic") {
- return $self->_run_via_expect_deterministic($expo,$expect_model);
- } elsif ($expect_model->{mode} eq "anyorder") {
- return $self->_run_via_expect_anyorder($expo,$expect_model);
- } else {
- die "Panic: Illegal expect mode: $expect_model->{mode}";
- }
- } else {
- $CPAN::Frontend->mywarn("Expect not installed, falling back to system()\n");
- return system($system);
- }
-}
-
-sub _run_via_expect_anyorder {
- my($self,$expo,$expect_model) = @_;
- my $timeout = $expect_model->{timeout} || 5;
- my $reuse = $expect_model->{reuse};
- my @expectacopy = @{$expect_model->{talk}}; # we trash it!
- my $but = "";
- EXPECT: while () {
- my($eof,$ran_into_timeout);
- my @match = $expo->expect($timeout,
- [ eof => sub {
- $eof++;
- } ],
- [ timeout => sub {
- $ran_into_timeout++;
- } ],
- -re => eval"qr{.}",
- );
- if ($match[2]) {
- $but .= $match[2];
- }
- $but .= $expo->clear_accum;
- if ($eof) {
- $expo->soft_close;
- return $expo->exitstatus();
- } elsif ($ran_into_timeout) {
- # warn "DEBUG: they are asking a question, but[$but]";
- for (my $i = 0; $i <= $#expectacopy; $i+=2) {
- my($next,$send) = @expectacopy[$i,$i+1];
- my $regex = eval "qr{$next}";
- # warn "DEBUG: will compare with regex[$regex].";
- if ($but =~ /$regex/) {
- # warn "DEBUG: will send send[$send]";
- $expo->send($send);
- # never allow reusing an QA pair unless they told us
- splice @expectacopy, $i, 2 unless $reuse;
- next EXPECT;
- }
- }
- my $why = "could not answer a question during the dialog";
- $CPAN::Frontend->mywarn("Failing: $why\n");
- $self->{writemakefile} =
- CPAN::Distrostatus->new("NO $why");
- return;
- }
- }
-}
-
-sub _run_via_expect_deterministic {
- my($self,$expo,$expect_model) = @_;
- my $ran_into_timeout;
- my $timeout = $expect_model->{timeout} || 15; # currently unsettable
- my $expecta = $expect_model->{talk};
- EXPECT: for (my $i = 0; $i <= $#$expecta; $i+=2) {
- my($re,$send) = @$expecta[$i,$i+1];
- CPAN->debug("timeout[$timeout]re[$re]") if $CPAN::DEBUG;
- my $regex = eval "qr{$re}";
- $expo->expect($timeout,
- [ eof => sub {
- my $but = $expo->clear_accum;
- $CPAN::Frontend->mywarn("EOF (maybe harmless)
-expected[$regex]\nbut[$but]\n\n");
- last EXPECT;
- } ],
- [ timeout => sub {
- my $but = $expo->clear_accum;
- $CPAN::Frontend->mywarn("TIMEOUT
-expected[$regex]\nbut[$but]\n\n");
- $ran_into_timeout++;
- } ],
- -re => $regex);
- if ($ran_into_timeout) {
- # note that the caller expects 0 for success
- $self->{writemakefile} =
- CPAN::Distrostatus->new("NO timeout during expect dialog");
- return;
- }
- $expo->send($send);
- }
- $expo->soft_close;
- return $expo->exitstatus();
-}
-
-#-> CPAN::Distribution::_validate_distropref
-sub _validate_distropref {
- my($self,@args) = @_;
- if (
- $CPAN::META->has_inst("CPAN::Kwalify")
- &&
- $CPAN::META->has_inst("Kwalify")
- ) {
- eval {CPAN::Kwalify::_validate("distroprefs",@args);};
- if ($@) {
- $CPAN::Frontend->mywarn($@);
- }
- } else {
- CPAN->debug("not validating '@args'") if $CPAN::DEBUG;
- }
-}
-
-#-> CPAN::Distribution::_find_prefs
-sub _find_prefs {
- my($self) = @_;
- my $distroid = $self->pretty_id;
- #CPAN->debug("distroid[$distroid]") if $CPAN::DEBUG;
- my $prefs_dir = $CPAN::Config->{prefs_dir};
- return if $prefs_dir =~ /^\s*$/;
- eval { File::Path::mkpath($prefs_dir); };
- if ($@) {
- $CPAN::Frontend->mydie("Cannot create directory $prefs_dir");
- }
- my $yaml_module = CPAN::_yaml_module;
- my @extensions;
- if ($CPAN::META->has_inst($yaml_module)) {
- push @extensions, "yml";
- } else {
- my @fallbacks;
- if ($CPAN::META->has_inst("Data::Dumper")) {
- push @extensions, "dd";
- push @fallbacks, "Data::Dumper";
- }
- if ($CPAN::META->has_inst("Storable")) {
- push @extensions, "st";
- push @fallbacks, "Storable";
- }
- if (@fallbacks) {
- local $" = " and ";
- unless ($self->{have_complained_about_missing_yaml}++) {
- $CPAN::Frontend->mywarn("'$yaml_module' not installed, falling back ".
- "to @fallbacks to read prefs '$prefs_dir'\n");
- }
- } else {
- unless ($self->{have_complained_about_missing_yaml}++) {
- $CPAN::Frontend->mywarn("'$yaml_module' not installed, cannot ".
- "read prefs '$prefs_dir'\n");
- }
- }
- }
- if (@extensions) {
- my $dh = DirHandle->new($prefs_dir)
- or die Carp::croak("Couldn't open '$prefs_dir': $!");
- DIRENT: for (sort $dh->read) {
- next if $_ eq "." || $_ eq "..";
- my $exte = join "|", @extensions;
- next unless /\.($exte)$/;
- my $thisexte = $1;
- my $abs = File::Spec->catfile($prefs_dir, $_);
- if (-f $abs) {
- #CPAN->debug(sprintf "abs[%s]", $abs) if $CPAN::DEBUG;
- my @distropref;
- if ($thisexte eq "yml") {
- # need no eval because if we have no YAML we do not try to read *.yml
- #CPAN->debug(sprintf "before yaml load abs[%s]", $abs) if $CPAN::DEBUG;
- @distropref = @{CPAN->_yaml_loadfile($abs)};
- #CPAN->debug(sprintf "after yaml load abs[%s]", $abs) if $CPAN::DEBUG;
- } elsif ($thisexte eq "dd") {
- package CPAN::Eval;
- no strict;
- open FH, "<$abs" or $CPAN::Frontend->mydie("Could not open '$abs': $!");
- local $/;
- my $eval = <FH>;
- close FH;
- eval $eval;
- if ($@) {
- $CPAN::Frontend->mydie("Error in distroprefs file $_\: $@");
- }
- my $i = 1;
- while (${"VAR".$i}) {
- push @distropref, ${"VAR".$i};
- $i++;
- }
- } elsif ($thisexte eq "st") {
- # eval because Storable is never forward compatible
- eval { @distropref = @{scalar Storable::retrieve($abs)}; };
- if ($@) {
- $CPAN::Frontend->mywarn("Error reading distroprefs file ".
- "$_, skipping\: $@");
- $CPAN::Frontend->mysleep(4);
- next DIRENT;
- }
- }
- # $DB::single=1;
- #CPAN->debug(sprintf "#distropref[%d]", scalar @distropref) if $CPAN::DEBUG;
- ELEMENT: for my $y (0..$#distropref) {
- my $distropref = $distropref[$y];
- $self->_validate_distropref($distropref,$abs,$y);
- my $match = $distropref->{match};
- unless ($match) {
- #CPAN->debug("no 'match' in abs[$abs], skipping") if $CPAN::DEBUG;
- next ELEMENT;
- }
- my $ok = 1;
- # do not take the order of C<keys %$match> because
- # "module" is by far the slowest
- my $saw_valid_subkeys = 0;
- for my $sub_attribute (qw(distribution perl perlconfig module)) {
- next unless exists $match->{$sub_attribute};
- $saw_valid_subkeys++;
- my $qr = eval "qr{$distropref->{match}{$sub_attribute}}";
- if ($sub_attribute eq "module") {
- my $okm = 0;
- #CPAN->debug(sprintf "distropref[%d]", scalar @distropref) if $CPAN::DEBUG;
- my @modules = $self->containsmods;
- #CPAN->debug(sprintf "modules[%s]", join(",",@modules)) if $CPAN::DEBUG;
- MODULE: for my $module (@modules) {
- $okm ||= $module =~ /$qr/;
- last MODULE if $okm;
- }
- $ok &&= $okm;
- } elsif ($sub_attribute eq "distribution") {
- my $okd = $distroid =~ /$qr/;
- $ok &&= $okd;
- } elsif ($sub_attribute eq "perl") {
- my $okp = CPAN::find_perl =~ /$qr/;
- $ok &&= $okp;
- } elsif ($sub_attribute eq "perlconfig") {
- for my $perlconfigkey (keys %{$match->{perlconfig}}) {
- my $perlconfigval = $match->{perlconfig}->{$perlconfigkey};
- # XXX should probably warn if Config does not exist
- my $okpc = $Config::Config{$perlconfigkey} =~ /$perlconfigval/;
- $ok &&= $okpc;
- last if $ok == 0;
- }
- } else {
- $CPAN::Frontend->mydie("Nonconforming .$thisexte file '$abs': ".
- "unknown sub_attribut '$sub_attribute'. ".
- "Please ".
- "remove, cannot continue.");
- }
- last if $ok == 0; # short circuit
- }
- unless ($saw_valid_subkeys) {
- $CPAN::Frontend->mydie("Nonconforming .$thisexte file '$abs': ".
- "missing match/* subattribute. ".
- "Please ".
- "remove, cannot continue.");
- }
- #CPAN->debug(sprintf "ok[%d]", $ok) if $CPAN::DEBUG;
- if ($ok) {
- return {
- prefs => $distropref,
- prefs_file => $abs,
- prefs_file_doc => $y,
- };
- }
-
- }
- }
- }
- $dh->close;
- }
- return;
-}
-
-# CPAN::Distribution::prefs
-sub prefs {
- my($self) = @_;
- if (exists $self->{negative_prefs_cache}
- &&
- $self->{negative_prefs_cache} != $CPAN::CurrentCommandId
- ) {
- delete $self->{negative_prefs_cache};
- delete $self->{prefs};
- }
- if (exists $self->{prefs}) {
- return $self->{prefs}; # XXX comment out during debugging
- }
- if ($CPAN::Config->{prefs_dir}) {
- CPAN->debug("prefs_dir[$CPAN::Config->{prefs_dir}]") if $CPAN::DEBUG;
- my $prefs = $self->_find_prefs();
- $prefs ||= ""; # avoid warning next line
- CPAN->debug("prefs[$prefs]") if $CPAN::DEBUG;
- if ($prefs) {
- for my $x (qw(prefs prefs_file prefs_file_doc)) {
- $self->{$x} = $prefs->{$x};
- }
- my $bs = sprintf(
- "%s[%s]",
- File::Basename::basename($self->{prefs_file}),
- $self->{prefs_file_doc},
- );
- my $filler1 = "_" x 22;
- my $filler2 = int(66 - length($bs))/2;
- $filler2 = 0 if $filler2 < 0;
- $filler2 = " " x $filler2;
- $CPAN::Frontend->myprint("
-$filler1 D i s t r o P r e f s $filler1
-$filler2 $bs $filler2
-");
- $CPAN::Frontend->mysleep(1);
- return $self->{prefs};
- }
- }
- $self->{negative_prefs_cache} = $CPAN::CurrentCommandId;
- return $self->{prefs} = +{};
-}
-
-# CPAN::Distribution::make_x_arg
-sub make_x_arg {
- my($self, $whixh) = @_;
- my $make_x_arg;
- my $prefs = $self->prefs;
- if (
- $prefs
- && exists $prefs->{$whixh}
- && exists $prefs->{$whixh}{args}
- && $prefs->{$whixh}{args}
- ) {
- $make_x_arg = join(" ",
- map {CPAN::HandleConfig
- ->safe_quote($_)} @{$prefs->{$whixh}{args}},
- );
- }
- my $what = sprintf "make%s_arg", $whixh eq "make" ? "" : $whixh;
- $make_x_arg ||= $CPAN::Config->{$what};
- return $make_x_arg;
-}
-
-# CPAN::Distribution::_make_command
-sub _make_command {
- my ($self) = @_;
- if ($self) {
- return
- CPAN::HandleConfig
- ->safe_quote(
- CPAN::HandleConfig->prefs_lookup($self,
- q{make})
- || $Config::Config{make}
- || 'make'
- );
- } else {
- # Old style call, without object. Deprecated
- Carp::confess("CPAN::_make_command() used as function. Don't Do That.");
- return
- safe_quote(undef,
- CPAN::HandleConfig->prefs_lookup($self,q{make})
- || $CPAN::Config->{make}
- || $Config::Config{make}
- || 'make');
- }
-}
-
-#-> sub CPAN::Distribution::follow_prereqs ;
-sub follow_prereqs {
- my($self) = shift;
- my($slot) = shift;
- my(@prereq_tuples) = grep {$_->[0] ne "perl"} @_;
- return unless @prereq_tuples;
- my @prereq = map { $_->[0] } @prereq_tuples;
- my $pretty_id = $self->pretty_id;
- my %map = (
- b => "build_requires",
- r => "requires",
- c => "commandline",
- );
- my($filler1,$filler2,$filler3,$filler4);
- # $DB::single=1;
- my $unsat = "Unsatisfied dependencies detected during";
- my $w = length($unsat) > length($pretty_id) ? length($unsat) : length($pretty_id);
- {
- my $r = int(($w - length($unsat))/2);
- my $l = $w - length($unsat) - $r;
- $filler1 = "-"x4 . " "x$l;
- $filler2 = " "x$r . "-"x4 . "\n";
- }
- {
- my $r = int(($w - length($pretty_id))/2);
- my $l = $w - length($pretty_id) - $r;
- $filler3 = "-"x4 . " "x$l;
- $filler4 = " "x$r . "-"x4 . "\n";
- }
- $CPAN::Frontend->
- myprint("$filler1 $unsat $filler2".
- "$filler3 $pretty_id $filler4".
- join("", map {" $_->[0] \[$map{$_->[1]}]\n"} @prereq_tuples),
- );
- my $follow = 0;
- if ($CPAN::Config->{prerequisites_policy} eq "follow") {
- $follow = 1;
- } elsif ($CPAN::Config->{prerequisites_policy} eq "ask") {
- my $answer = CPAN::Shell::colorable_makemaker_prompt(
-"Shall I follow them and prepend them to the queue
-of modules we are processing right now?", "yes");
- $follow = $answer =~ /^\s*y/i;
- } else {
- local($") = ", ";
- $CPAN::Frontend->
- myprint(" Ignoring dependencies on modules @prereq\n");
- }
- if ($follow) {
- my $id = $self->id;
- # color them as dirty
- for my $p (@prereq) {
- # warn "calling color_cmd_tmps(0,1)";
- my $any = CPAN::Shell->expandany($p);
- $self->{$slot . "_for"}{$any->id}++;
- if ($any) {
- $any->color_cmd_tmps(0,2);
- } else {
- $CPAN::Frontend->mywarn("Warning (maybe a bug): Cannot expand prereq '$p'\n");
- $CPAN::Frontend->mysleep(2);
- }
- }
- # queue them and re-queue yourself
- CPAN::Queue->jumpqueue({qmod => $id, reqtype => $self->{reqtype}},
- map {+{qmod=>$_->[0],reqtype=>$_->[1]}} reverse @prereq_tuples);
- $self->{$slot} = "Delayed until after prerequisites";
- return 1; # signal success to the queuerunner
- }
- return;
-}
-
-#-> sub CPAN::Distribution::unsat_prereq ;
-# return ([Foo=>1],[Bar=>1.2]) for normal modules
-# return ([perl=>5.008]) if we need a newer perl than we are running under
-sub unsat_prereq {
- my($self,$slot) = @_;
- my(%merged,$prereq_pm);
- my $prefs_depends = $self->prefs->{depends}||{};
- if ($slot eq "configure_requires_later") {
- my $meta_yml = $self->parse_meta_yml();
- %merged = (%{$meta_yml->{configure_requires}||{}},
- %{$prefs_depends->{configure_requires}||{}});
- $prereq_pm = {}; # configure_requires defined as "b"
- } elsif ($slot eq "later") {
- my $prereq_pm_0 = $self->prereq_pm || {};
- for my $reqtype (qw(requires build_requires)) {
- $prereq_pm->{$reqtype} = {%{$prereq_pm_0->{$reqtype}||{}}}; # copy to not pollute it
- for my $k (keys %{$prefs_depends->{$reqtype}||{}}) {
- $prereq_pm->{$reqtype}{$k} = $prefs_depends->{$reqtype}{$k};
- }
- }
- %merged = (%{$prereq_pm->{requires}||{}},%{$prereq_pm->{build_requires}||{}});
- } else {
- die "Panic: illegal slot '$slot'";
- }
- my(@need);
- my @merged = %merged;
- CPAN->debug("all merged_prereqs[@merged]") if $CPAN::DEBUG;
- NEED: while (my($need_module, $need_version) = each %merged) {
- my($available_version,$available_file,$nmo);
- if ($need_module eq "perl") {
- $available_version = $];
- $available_file = CPAN::find_perl;
- } else {
- $nmo = $CPAN::META->instance("CPAN::Module",$need_module);
- next if $nmo->uptodate;
- $available_file = $nmo->available_file;
-
- # if they have not specified a version, we accept any installed one
- if (defined $available_file
- and ( # a few quick shortcurcuits
- not defined $need_version
- or $need_version eq '0' # "==" would trigger warning when not numeric
- or $need_version eq "undef"
- )) {
- next NEED;
- }
-
- $available_version = $nmo->available_version;
- }
-
- # We only want to install prereqs if either they're not installed
- # or if the installed version is too old. We cannot omit this
- # check, because if 'force' is in effect, nobody else will check.
- if (defined $available_file) {
- my(@all_requirements) = split /\s*,\s*/, $need_version;
- local($^W) = 0;
- my $ok = 0;
- RQ: for my $rq (@all_requirements) {
- if ($rq =~ s|>=\s*||) {
- } elsif ($rq =~ s|>\s*||) {
- # 2005-12: one user
- if (CPAN::Version->vgt($available_version,$rq)) {
- $ok++;
- }
- next RQ;
- } elsif ($rq =~ s|!=\s*||) {
- # 2005-12: no user
- if (CPAN::Version->vcmp($available_version,$rq)) {
- $ok++;
- next RQ;
- } else {
- last RQ;
- }
- } elsif ($rq =~ m|<=?\s*|) {
- # 2005-12: no user
- $CPAN::Frontend->mywarn("Downgrading not supported (rq[$rq])\n");
- $ok++;
- next RQ;
- }
- if (! CPAN::Version->vgt($rq, $available_version)) {
- $ok++;
- }
- CPAN->debug(sprintf("need_module[%s]available_file[%s]".
- "available_version[%s]rq[%s]ok[%d]",
- $need_module,
- $available_file,
- $available_version,
- CPAN::Version->readable($rq),
- $ok,
- )) if $CPAN::DEBUG;
- }
- next NEED if $ok == @all_requirements;
- }
-
- if ($need_module eq "perl") {
- return ["perl", $need_version];
- }
- $self->{sponsored_mods}{$need_module} ||= 0;
- CPAN->debug("need_module[$need_module]s/s/n[$self->{sponsored_mods}{$need_module}]") if $CPAN::DEBUG;
- if ($self->{sponsored_mods}{$need_module}++) {
- # We have already sponsored it and for some reason it's still
- # not available. So we do ... what??
-
- # if we push it again, we have a potential infinite loop
-
- # The following "next" was a very problematic construct.
- # It helped a lot but broke some day and had to be
- # replaced.
-
- # We must be able to deal with modules that come again and
- # again as a prereq and have themselves prereqs and the
- # queue becomes long but finally we would find the correct
- # order. The RecursiveDependency check should trigger a
- # die when it's becoming too weird. Unfortunately removing
- # this next breaks many other things.
-
- # The bug that brought this up is described in Todo under
- # "5.8.9 cannot install Compress::Zlib"
-
- # next; # this is the next that had to go away
-
- # The following "next NEED" are fine and the error message
- # explains well what is going on. For example when the DBI
- # fails and consequently DBD::SQLite fails and now we are
- # processing CPAN::SQLite. Then we must have a "next" for
- # DBD::SQLite. How can we get it and how can we identify
- # all other cases we must identify?
-
- my $do = $nmo->distribution;
- next NEED unless $do; # not on CPAN
- if (CPAN::Version->vcmp($need_version, $nmo->ro->{CPAN_VERSION}) > 0){
- $CPAN::Frontend->mywarn("Warning: Prerequisite ".
- "'$need_module => $need_version' ".
- "for '$self->{ID}' seems ".
- "not available according to the indexes\n"
- );
- next NEED;
- }
- NOSAYER: for my $nosayer (
- "unwrapped",
- "writemakefile",
- "signature_verify",
- "make",
- "make_test",
- "install",
- "make_clean",
- ) {
- if ($do->{$nosayer}) {
- if (UNIVERSAL::can($do->{$nosayer},"failed") ?
- $do->{$nosayer}->failed :
- $do->{$nosayer} =~ /^NO/) {
- if ($nosayer eq "make_test"
- &&
- $do->{make_test}{COMMANDID} != $CPAN::CurrentCommandId
- ) {
- next NOSAYER;
- }
- $CPAN::Frontend->mywarn("Warning: Prerequisite ".
- "'$need_module => $need_version' ".
- "for '$self->{ID}' failed when ".
- "processing '$do->{ID}' with ".
- "'$nosayer => $do->{$nosayer}'. Continuing, ".
- "but chances to succeed are limited.\n"
- );
- next NEED;
- } else { # the other guy succeeded
- if ($nosayer eq "install") {
- # we had this with
- # DMAKI/DateTime-Calendar-Chinese-0.05.tar.gz
- # 2007-03
- $CPAN::Frontend->mywarn("Warning: Prerequisite ".
- "'$need_module => $need_version' ".
- "for '$self->{ID}' already installed ".
- "but installation looks suspicious. ".
- "Skipping another installation attempt, ".
- "to prevent looping endlessly.\n"
- );
- next NEED;
- }
- }
- }
- }
- }
- my $needed_as = exists $prereq_pm->{requires}{$need_module} ? "r" : "b";
- push @need, [$need_module,$needed_as];
- }
- my @unfolded = map { "[".join(",",@$_)."]" } @need;
- CPAN->debug("returning from unsat_prereq[@unfolded]") if $CPAN::DEBUG;
- @need;
-}
-
-#-> sub CPAN::Distribution::read_yaml ;
-sub read_yaml {
- my($self) = @_;
- return $self->{yaml_content} if exists $self->{yaml_content};
- my $build_dir = $self->{build_dir};
- my $yaml = File::Spec->catfile($build_dir,"META.yml");
- $self->debug("yaml[$yaml]") if $CPAN::DEBUG;
- return unless -f $yaml;
- eval { $self->{yaml_content} = CPAN->_yaml_loadfile($yaml)->[0]; };
- if ($@) {
- $CPAN::Frontend->mywarn("Could not read ".
- "'$yaml'. Falling back to other ".
- "methods to determine prerequisites\n");
- return $self->{yaml_content} = undef; # if we die, then we
- # cannot read YAML's own
- # META.yml
- }
- # not "authoritative"
- if (not exists $self->{yaml_content}{dynamic_config}
- or $self->{yaml_content}{dynamic_config}
- ) {
- $self->{yaml_content} = undef;
- }
- $self->debug(sprintf "yaml_content[%s]", $self->{yaml_content} || "UNDEF")
- if $CPAN::DEBUG;
- return $self->{yaml_content};
-}
-
-#-> sub CPAN::Distribution::prereq_pm ;
-sub prereq_pm {
- my($self) = @_;
- $self->{prereq_pm_detected} ||= 0;
- CPAN->debug("ID[$self->{ID}]prereq_pm_detected[$self->{prereq_pm_detected}]") if $CPAN::DEBUG;
- return $self->{prereq_pm} if $self->{prereq_pm_detected};
- return unless $self->{writemakefile} # no need to have succeeded
- # but we must have run it
- || $self->{modulebuild};
- CPAN->debug(sprintf "writemakefile[%s]modulebuild[%s]",
- $self->{writemakefile}||"",
- $self->{modulebuild}||"",
- ) if $CPAN::DEBUG;
- my($req,$breq);
- if (my $yaml = $self->read_yaml) { # often dynamic_config prevents a result here
- $req = $yaml->{requires} || {};
- $breq = $yaml->{build_requires} || {};
- undef $req unless ref $req eq "HASH" && %$req;
- if ($req) {
- if ($yaml->{generated_by} &&
- $yaml->{generated_by} =~ /ExtUtils::MakeMaker version ([\d\._]+)/) {
- my $eummv = do { local $^W = 0; $1+0; };
- if ($eummv < 6.2501) {
- # thanks to Slaven for digging that out: MM before
- # that could be wrong because it could reflect a
- # previous release
- undef $req;
- }
- }
- my $areq;
- my $do_replace;
- while (my($k,$v) = each %{$req||{}}) {
- if ($v =~ /\d/) {
- $areq->{$k} = $v;
- } elsif ($k =~ /[A-Za-z]/ &&
- $v =~ /[A-Za-z]/ &&
- $CPAN::META->exists("Module",$v)
- ) {
- $CPAN::Frontend->mywarn("Suspicious key-value pair in META.yml's ".
- "requires hash: $k => $v; I'll take both ".
- "key and value as a module name\n");
- $CPAN::Frontend->mysleep(1);
- $areq->{$k} = 0;
- $areq->{$v} = 0;
- $do_replace++;
- }
- }
- $req = $areq if $do_replace;
- }
- }
- unless ($req || $breq) {
- my $build_dir = $self->{build_dir} or die "Panic: no build_dir?";
- my $makefile = File::Spec->catfile($build_dir,"Makefile");
- my $fh;
- if (-f $makefile
- and
- $fh = FileHandle->new("<$makefile\0")) {
- CPAN->debug("Getting prereq from Makefile") if $CPAN::DEBUG;
- local($/) = "\n";
- while (<$fh>) {
- last if /MakeMaker post_initialize section/;
- my($p) = m{^[\#]
- \s+PREREQ_PM\s+=>\s+(.+)
- }x;
- next unless $p;
- # warn "Found prereq expr[$p]";
-
- # Regexp modified by A.Speer to remember actual version of file
- # PREREQ_PM hash key wants, then add to
- while ( $p =~ m/(?:\s)([\w\:]+)=>(q\[.*?\]|undef),?/g ) {
- # In case a prereq is mentioned twice, complain.
- if ( defined $req->{$1} ) {
- warn "Warning: PREREQ_PM mentions $1 more than once, ".
- "last mention wins";
- }
- my($m,$n) = ($1,$2);
- if ($n =~ /^q\[(.*?)\]$/) {
- $n = $1;
- }
- $req->{$m} = $n;
- }
- last;
- }
- }
- }
- unless ($req || $breq) {
- my $build_dir = $self->{build_dir} or die "Panic: no build_dir?";
- my $buildfile = File::Spec->catfile($build_dir,"Build");
- if (-f $buildfile) {
- CPAN->debug("Found '$buildfile'") if $CPAN::DEBUG;
- my $build_prereqs = File::Spec->catfile($build_dir,"_build","prereqs");
- if (-f $build_prereqs) {
- CPAN->debug("Getting prerequisites from '$build_prereqs'") if $CPAN::DEBUG;
- my $content = do { local *FH;
- open FH, $build_prereqs
- or $CPAN::Frontend->mydie("Could not open ".
- "'$build_prereqs': $!");
- local $/;
- <FH>;
- };
- my $bphash = eval $content;
- if ($@) {
- } else {
- $req = $bphash->{requires} || +{};
- $breq = $bphash->{build_requires} || +{};
- }
- }
- }
- }
- if (-f "Build.PL"
- && ! -f "Makefile.PL"
- && ! exists $req->{"Module::Build"}
- && ! $CPAN::META->has_inst("Module::Build")) {
- $CPAN::Frontend->mywarn(" Warning: CPAN.pm discovered Module::Build as ".
- "undeclared prerequisite.\n".
- " Adding it now as such.\n"
- );
- $CPAN::Frontend->mysleep(5);
- $req->{"Module::Build"} = 0;
- delete $self->{writemakefile};
- }
- if ($req || $breq) {
- $self->{prereq_pm_detected}++;
- return $self->{prereq_pm} = { requires => $req, build_requires => $breq };
- }
-}
-
-#-> sub CPAN::Distribution::test ;
-sub test {
- my($self) = @_;
- if (my $goto = $self->prefs->{goto}) {
- return $self->goto($goto);
- }
- $self->make;
- if ($CPAN::Signal) {
- delete $self->{force_update};
- return;
- }
- # warn "XDEBUG: checking for notest: $self->{notest} $self";
- if ($self->{notest}) {
- $CPAN::Frontend->myprint("Skipping test because of notest pragma\n");
- return 1;
- }
-
- my $make = $self->{modulebuild} ? "Build" : "make";
-
- local $ENV{PERL5LIB} = defined($ENV{PERL5LIB})
- ? $ENV{PERL5LIB}
- : ($ENV{PERLLIB} || "");
-
- $CPAN::META->set_perl5lib;
- local $ENV{MAKEFLAGS}; # protect us from outer make calls
-
- $CPAN::Frontend->myprint("Running $make test\n");
-
- EXCUSE: {
- my @e;
- if ($self->{make} or $self->{later}) {
- # go ahead
- } else {
- push @e,
- "Make had some problems, won't test";
- }
-
- exists $self->{make} and
- (
- UNIVERSAL::can($self->{make},"failed") ?
- $self->{make}->failed :
- $self->{make} =~ /^NO/
- ) and push @e, "Can't test without successful make";
- $self->{badtestcnt} ||= 0;
- if ($self->{badtestcnt} > 0) {
- require Data::Dumper;
- CPAN->debug(sprintf "NOREPEAT[%s]", Data::Dumper::Dumper($self)) if $CPAN::DEBUG;
- push @e, "Won't repeat unsuccessful test during this command";
- }
-
- push @e, $self->{later} if $self->{later};
- push @e, $self->{configure_requires_later} if $self->{configure_requires_later};
-
- if (exists $self->{build_dir}) {
- if (exists $self->{make_test}) {
- if (
- UNIVERSAL::can($self->{make_test},"failed") ?
- $self->{make_test}->failed :
- $self->{make_test} =~ /^NO/
- ) {
- if (
- UNIVERSAL::can($self->{make_test},"commandid")
- &&
- $self->{make_test}->commandid == $CPAN::CurrentCommandId
- ) {
- push @e, "Has already been tested within this command";
- }
- } else {
- push @e, "Has already been tested successfully";
- }
- }
- } elsif (!@e) {
- push @e, "Has no own directory";
- }
- $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
- unless (chdir $self->{build_dir}) {
- push @e, "Couldn't chdir to '$self->{build_dir}': $!";
- }
- $CPAN::Frontend->mywarn(join "", map {" $_\n"} @e) and return if @e;
- }
- $self->debug("Changed directory to $self->{build_dir}")
- if $CPAN::DEBUG;
-
- if ($^O eq 'MacOS') {
- Mac::BuildTools::make_test($self);
- return;
- }
-
- if ($self->{modulebuild}) {
- my $v = CPAN::Shell->expand("Module","Test::Harness")->inst_version;
- if (CPAN::Version->vlt($v,2.62)) {
- $CPAN::Frontend->mywarn(qq{The version of your Test::Harness is only
- '$v', you need at least '2.62'. Please upgrade your Test::Harness.\n});
- $self->{make_test} = CPAN::Distrostatus->new("NO Test::Harness too old");
- return;
- }
- }
-
- my $system;
- my $prefs_test = $self->prefs->{test};
- if (my $commandline
- = exists $prefs_test->{commandline} ? $prefs_test->{commandline} : "") {
- $system = $commandline;
- $ENV{PERL} = CPAN::find_perl;
- } elsif ($self->{modulebuild}) {
- $system = sprintf "%s test", $self->_build_command();
- } else {
- $system = join " ", $self->_make_command(), "test";
- }
- my $make_test_arg = $self->make_x_arg("test");
- $system = sprintf("%s%s",
- $system,
- $make_test_arg ? " $make_test_arg" : "",
- );
- my($tests_ok);
- my %env;
- while (my($k,$v) = each %ENV) {
- next unless defined $v;
- $env{$k} = $v;
- }
- local %ENV = %env;
- if (my $env = $self->prefs->{test}{env}) {
- for my $e (keys %$env) {
- $ENV{$e} = $env->{$e};
- }
- }
- my $expect_model = $self->_prefs_with_expect("test");
- my $want_expect = 0;
- if ( $expect_model && @{$expect_model->{talk}} ) {
- my $can_expect = $CPAN::META->has_inst("Expect");
- if ($can_expect) {
- $want_expect = 1;
- } else {
- $CPAN::Frontend->mywarn("Expect not installed, falling back to ".
- "testing without\n");
- }
- }
- if ($want_expect) {
- if ($self->_should_report('test')) {
- $CPAN::Frontend->mywarn("Reporting via CPAN::Reporter is currently ".
- "not supported when distroprefs specify ".
- "an interactive test\n");
- }
- $tests_ok = $self->_run_via_expect($system,$expect_model) == 0;
- } elsif ( $self->_should_report('test') ) {
- $tests_ok = CPAN::Reporter::test($self, $system);
- } else {
- $tests_ok = system($system) == 0;
- }
- $self->introduce_myself;
- if ( $tests_ok ) {
- {
- my @prereq;
-
- # local $CPAN::DEBUG = 16; # Distribution
- for my $m (keys %{$self->{sponsored_mods}}) {
- next unless $self->{sponsored_mods}{$m} > 0;
- my $m_obj = CPAN::Shell->expand("Module",$m) or next;
- # XXX we need available_version which reflects
- # $ENV{PERL5LIB} so that already tested but not yet
- # installed modules are counted.
- my $available_version = $m_obj->available_version;
- my $available_file = $m_obj->available_file;
- if ($available_version &&
- !CPAN::Version->vlt($available_version,$self->{prereq_pm}{$m})
- ) {
- CPAN->debug("m[$m] good enough available_version[$available_version]")
- if $CPAN::DEBUG;
- } elsif ($available_file
- && (
- !$self->{prereq_pm}{$m}
- ||
- $self->{prereq_pm}{$m} == 0
- )
- ) {
- # lex Class::Accessor::Chained::Fast which has no $VERSION
- CPAN->debug("m[$m] have available_file[$available_file]")
- if $CPAN::DEBUG;
- } else {
- push @prereq, $m;
- }
- }
- if (@prereq) {
- my $cnt = @prereq;
- my $which = join ",", @prereq;
- my $but = $cnt == 1 ? "one dependency not OK ($which)" :
- "$cnt dependencies missing ($which)";
- $CPAN::Frontend->mywarn("Tests succeeded but $but\n");
- $self->{make_test} = CPAN::Distrostatus->new("NO $but");
- $self->store_persistent_state;
- return $self->goodbye("[dependencies] -- NA");
- }
- }
-
- $CPAN::Frontend->myprint(" $system -- OK\n");
- $self->{make_test} = CPAN::Distrostatus->new("YES");
- $CPAN::META->is_tested($self->{build_dir},$self->{make_test}{TIME});
- # probably impossible to need the next line because badtestcnt
- # has a lifespan of one command
- delete $self->{badtestcnt};
- } else {
- $self->{make_test} = CPAN::Distrostatus->new("NO");
- $self->{badtestcnt}++;
- $CPAN::Frontend->mywarn(" $system -- NOT OK\n");
- CPAN::Shell->optprint
- ("hint",
- sprintf
- ("//hint// to see the cpan-testers results for installing this module, try:
- reports %s\n",
- $self->pretty_id));
- }
- $self->store_persistent_state;
-}
-
-sub _prefs_with_expect {
- my($self,$where) = @_;
- return unless my $prefs = $self->prefs;
- return unless my $where_prefs = $prefs->{$where};
- if ($where_prefs->{expect}) {
- return {
- mode => "deterministic",
- timeout => 15,
- talk => $where_prefs->{expect},
- };
- } elsif ($where_prefs->{"eexpect"}) {
- return $where_prefs->{"eexpect"};
- }
- return;
-}
-
-#-> sub CPAN::Distribution::clean ;
-sub clean {
- my($self) = @_;
- my $make = $self->{modulebuild} ? "Build" : "make";
- $CPAN::Frontend->myprint("Running $make clean\n");
- unless (exists $self->{archived}) {
- $CPAN::Frontend->mywarn("Distribution seems to have never been unzipped".
- "/untarred, nothing done\n");
- return 1;
- }
- unless (exists $self->{build_dir}) {
- $CPAN::Frontend->mywarn("Distribution has no own directory, nothing to do.\n");
- return 1;
- }
- if (exists $self->{writemakefile}
- and $self->{writemakefile}->failed
- ) {
- $CPAN::Frontend->mywarn("No Makefile, don't know how to 'make clean'\n");
- return 1;
- }
- EXCUSE: {
- my @e;
- exists $self->{make_clean} and $self->{make_clean} eq "YES" and
- push @e, "make clean already called once";
- $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
- }
- chdir $self->{build_dir} or
- Carp::confess("Couldn't chdir to $self->{build_dir}: $!");
- $self->debug("Changed directory to $self->{build_dir}") if $CPAN::DEBUG;
-
- if ($^O eq 'MacOS') {
- Mac::BuildTools::make_clean($self);
- return;
- }
-
- my $system;
- if ($self->{modulebuild}) {
- unless (-f "Build") {
- my $cwd = CPAN::anycwd();
- $CPAN::Frontend->mywarn("Alert: no Build file available for 'clean $self->{id}".
- " in cwd[$cwd]. Danger, Will Robinson!");
- $CPAN::Frontend->mysleep(5);
- }
- $system = sprintf "%s clean", $self->_build_command();
- } else {
- $system = join " ", $self->_make_command(), "clean";
- }
- my $system_ok = system($system) == 0;
- $self->introduce_myself;
- if ( $system_ok ) {
- $CPAN::Frontend->myprint(" $system -- OK\n");
-
- # $self->force;
-
- # Jost Krieger pointed out that this "force" was wrong because
- # it has the effect that the next "install" on this distribution
- # will untar everything again. Instead we should bring the
- # object's state back to where it is after untarring.
-
- for my $k (qw(
- force_update
- install
- writemakefile
- make
- make_test
- )) {
- delete $self->{$k};
- }
- $self->{make_clean} = CPAN::Distrostatus->new("YES");
-
- } else {
- # Hmmm, what to do if make clean failed?
-
- $self->{make_clean} = CPAN::Distrostatus->new("NO");
- $CPAN::Frontend->mywarn(qq{ $system -- NOT OK\n});
-
- # 2006-02-27: seems silly to me to force a make now
- # $self->force("make"); # so that this directory won't be used again
-
- }
- $self->store_persistent_state;
-}
-
-#-> sub CPAN::Distribution::goto ;
-sub goto {
- my($self,$goto) = @_;
- $goto = $self->normalize($goto);
- my $why = sprintf(
- "Goto '$goto' via prefs file '%s' doc %d",
- $self->{prefs_file},
- $self->{prefs_file_doc},
- );
- $self->{unwrapped} = CPAN::Distrostatus->new("NO $why");
- # 2007-07-16 akoenig : Better than NA would be if we could inherit
- # the status of the $goto distro but given the exceptional nature
- # of 'goto' I feel reluctant to implement it
- my $goodbye_message = "[goto] -- NA $why";
- $self->goodbye($goodbye_message);
-
- # inject into the queue
-
- CPAN::Queue->delete($self->id);
- CPAN::Queue->jumpqueue({qmod => $goto, reqtype => $self->{reqtype}});
-
- # and run where we left off
-
- my($method) = (caller(1))[3];
- CPAN->instance("CPAN::Distribution",$goto)->$method();
- CPAN::Queue->delete_first($goto);
-}
-
-#-> sub CPAN::Distribution::install ;
-sub install {
- my($self) = @_;
- if (my $goto = $self->prefs->{goto}) {
- return $self->goto($goto);
- }
- # $DB::single=1;
- unless ($self->{badtestcnt}) {
- $self->test;
- }
- if ($CPAN::Signal) {
- delete $self->{force_update};
- return;
- }
- my $make = $self->{modulebuild} ? "Build" : "make";
- $CPAN::Frontend->myprint("Running $make install\n");
- EXCUSE: {
- my @e;
- if ($self->{make} or $self->{later}) {
- # go ahead
- } else {
- push @e,
- "Make had some problems, won't install";
- }
-
- exists $self->{make} and
- (
- UNIVERSAL::can($self->{make},"failed") ?
- $self->{make}->failed :
- $self->{make} =~ /^NO/
- ) and
- push @e, "Make had returned bad status, install seems impossible";
-
- if (exists $self->{build_dir}) {
- } elsif (!@e) {
- push @e, "Has no own directory";
- }
-
- if (exists $self->{make_test} and
- (
- UNIVERSAL::can($self->{make_test},"failed") ?
- $self->{make_test}->failed :
- $self->{make_test} =~ /^NO/
- )) {
- if ($self->{force_update}) {
- $self->{make_test}->text("FAILED but failure ignored because ".
- "'force' in effect");
- } else {
- push @e, "make test had returned bad status, ".
- "won't install without force"
- }
- }
- if (exists $self->{install}) {
- if (UNIVERSAL::can($self->{install},"text") ?
- $self->{install}->text eq "YES" :
- $self->{install} =~ /^YES/
- ) {
- $CPAN::Frontend->myprint(" Already done\n");
- $CPAN::META->is_installed($self->{build_dir});
- return 1;
- } else {
- # comment in Todo on 2006-02-11; maybe retry?
- push @e, "Already tried without success";
- }
- }
-
- push @e, $self->{later} if $self->{later};
- push @e, $self->{configure_requires_later} if $self->{configure_requires_later};
-
- $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
- unless (chdir $self->{build_dir}) {
- push @e, "Couldn't chdir to '$self->{build_dir}': $!";
- }
- $CPAN::Frontend->mywarn(join "", map {" $_\n"} @e) and return if @e;
- }
- $self->debug("Changed directory to $self->{build_dir}")
- if $CPAN::DEBUG;
-
- if ($^O eq 'MacOS') {
- Mac::BuildTools::make_install($self);
- return;
- }
-
- my $system;
- if (my $commandline = $self->prefs->{install}{commandline}) {
- $system = $commandline;
- $ENV{PERL} = CPAN::find_perl;
- } elsif ($self->{modulebuild}) {
- my($mbuild_install_build_command) =
- exists $CPAN::HandleConfig::keys{mbuild_install_build_command} &&
- $CPAN::Config->{mbuild_install_build_command} ?
- $CPAN::Config->{mbuild_install_build_command} :
- $self->_build_command();
- $system = sprintf("%s install %s",
- $mbuild_install_build_command,
- $CPAN::Config->{mbuild_install_arg},
- );
- } else {
- my($make_install_make_command) =
- CPAN::HandleConfig->prefs_lookup($self,
- q{make_install_make_command})
- || $self->_make_command();
- $system = sprintf("%s install %s",
- $make_install_make_command,
- $CPAN::Config->{make_install_arg},
- );
- }
-
- my($stderr) = $^O eq "MSWin32" ? "" : " 2>&1 ";
- my $brip = CPAN::HandleConfig->prefs_lookup($self,
- q{build_requires_install_policy});
- $brip ||="ask/yes";
- my $id = $self->id;
- my $reqtype = $self->{reqtype} ||= "c"; # in doubt it was a command
- my $want_install = "yes";
- if ($reqtype eq "b") {
- if ($brip eq "no") {
- $want_install = "no";
- } elsif ($brip =~ m|^ask/(.+)|) {
- my $default = $1;
- $default = "yes" unless $default =~ /^(y|n)/i;
- $want_install =
- CPAN::Shell::colorable_makemaker_prompt
- ("$id is just needed temporarily during building or testing. ".
- "Do you want to install it permanently? (Y/n)",
- $default);
- }
- }
- unless ($want_install =~ /^y/i) {
- my $is_only = "is only 'build_requires'";
- $CPAN::Frontend->mywarn("Not installing because $is_only\n");
- $self->{install} = CPAN::Distrostatus->new("NO -- $is_only");
- delete $self->{force_update};
- return;
- }
- local $ENV{PERL5LIB} = defined($ENV{PERL5LIB})
- ? $ENV{PERL5LIB}
- : ($ENV{PERLLIB} || "");
-
- $CPAN::META->set_perl5lib;
- my($pipe) = FileHandle->new("$system $stderr |");
- my($makeout) = "";
- while (<$pipe>) {
- print $_; # intentionally NOT use Frontend->myprint because it
- # looks irritating when we markup in color what we
- # just pass through from an external program
- $makeout .= $_;
- }
- $pipe->close;
- my $close_ok = $? == 0;
- $self->introduce_myself;
- if ( $close_ok ) {
- $CPAN::Frontend->myprint(" $system -- OK\n");
- $CPAN::META->is_installed($self->{build_dir});
- $self->{install} = CPAN::Distrostatus->new("YES");
- } else {
- $self->{install} = CPAN::Distrostatus->new("NO");
- $CPAN::Frontend->mywarn(" $system -- NOT OK\n");
- my $mimc =
- CPAN::HandleConfig->prefs_lookup($self,
- q{make_install_make_command});
- if (
- $makeout =~ /permission/s
- && $> > 0
- && (
- ! $mimc
- || $mimc eq (CPAN::HandleConfig->prefs_lookup($self,
- q{make}))
- )
- ) {
- $CPAN::Frontend->myprint(
- qq{----\n}.
- qq{ You may have to su }.
- qq{to root to install the package\n}.
- qq{ (Or you may want to run something like\n}.
- qq{ o conf make_install_make_command 'sudo make'\n}.
- qq{ to raise your permissions.}
- );
- }
- }
- delete $self->{force_update};
- # $DB::single = 1;
- $self->store_persistent_state;
-}
-
-sub introduce_myself {
- my($self) = @_;
- $CPAN::Frontend->myprint(sprintf(" %s\n",$self->pretty_id));
-}
-
-#-> sub CPAN::Distribution::dir ;
-sub dir {
- shift->{build_dir};
-}
-
-#-> sub CPAN::Distribution::perldoc ;
-sub perldoc {
- my($self) = @_;
-
- my($dist) = $self->id;
- my $package = $self->called_for;
-
- $self->_display_url( $CPAN::Defaultdocs . $package );
-}
-
-#-> sub CPAN::Distribution::_check_binary ;
-sub _check_binary {
- my ($dist,$shell,$binary) = @_;
- my ($pid,$out);
-
- $CPAN::Frontend->myprint(qq{ + _check_binary($binary)\n})
- if $CPAN::DEBUG;
-
- if ($CPAN::META->has_inst("File::Which")) {
- return File::Which::which($binary);
- } else {
- local *README;
- $pid = open README, "which $binary|"
- or $CPAN::Frontend->mywarn(qq{Could not fork 'which $binary': $!\n});
- return unless $pid;
- while (<README>) {
- $out .= $_;
- }
- close README
- or $CPAN::Frontend->mywarn("Could not run 'which $binary': $!\n")
- and return;
- }
-
- $CPAN::Frontend->myprint(qq{ + $out \n})
- if $CPAN::DEBUG && $out;
-
- return $out;
-}
-
-#-> sub CPAN::Distribution::_display_url ;
-sub _display_url {
- my($self,$url) = @_;
- my($res,$saved_file,$pid,$out);
-
- $CPAN::Frontend->myprint(qq{ + _display_url($url)\n})
- if $CPAN::DEBUG;
-
- # should we define it in the config instead?
- my $html_converter = "html2text.pl";
-
- my $web_browser = $CPAN::Config->{'lynx'} || undef;
- my $web_browser_out = $web_browser
- ? CPAN::Distribution->_check_binary($self,$web_browser)
- : undef;
-
- if ($web_browser_out) {
- # web browser found, run the action
- my $browser = CPAN::HandleConfig->safe_quote($CPAN::Config->{'lynx'});
- $CPAN::Frontend->myprint(qq{system[$browser $url]})
- if $CPAN::DEBUG;
- $CPAN::Frontend->myprint(qq{
-Displaying URL
- $url
-with browser $browser
-});
- $CPAN::Frontend->mysleep(1);
- system("$browser $url");
- if ($saved_file) { 1 while unlink($saved_file) }
- } else {
- # web browser not found, let's try text only
- my $html_converter_out =
- CPAN::Distribution->_check_binary($self,$html_converter);
- $html_converter_out = CPAN::HandleConfig->safe_quote($html_converter_out);
-
- if ($html_converter_out ) {
- # html2text found, run it
- $saved_file = CPAN::Distribution->_getsave_url( $self, $url );
- $CPAN::Frontend->mydie(qq{ERROR: problems while getting $url\n})
- unless defined($saved_file);
-
- local *README;
- $pid = open README, "$html_converter $saved_file |"
- or $CPAN::Frontend->mydie(qq{
-Could not fork '$html_converter $saved_file': $!});
- my($fh,$filename);
- if ($CPAN::META->has_usable("File::Temp")) {
- $fh = File::Temp->new(
- dir => File::Spec->tmpdir,
- template => 'cpan_htmlconvert_XXXX',
- suffix => '.txt',
- unlink => 0,
- );
- $filename = $fh->filename;
- } else {
- $filename = "cpan_htmlconvert_$$.txt";
- $fh = FileHandle->new();
- open $fh, ">$filename" or die;
- }
- while (<README>) {
- $fh->print($_);
- }
- close README or
- $CPAN::Frontend->mydie(qq{Could not run '$html_converter $saved_file': $!});
- my $tmpin = $fh->filename;
- $CPAN::Frontend->myprint(sprintf(qq{
-Run '%s %s' and
-saved output to %s\n},
- $html_converter,
- $saved_file,
- $tmpin,
- )) if $CPAN::DEBUG;
- close $fh;
- local *FH;
- open FH, $tmpin
- or $CPAN::Frontend->mydie(qq{Could not open "$tmpin": $!});
- my $fh_pager = FileHandle->new;
- local($SIG{PIPE}) = "IGNORE";
- my $pager = $CPAN::Config->{'pager'} || "cat";
- $fh_pager->open("|$pager")
- or $CPAN::Frontend->mydie(qq{
-Could not open pager '$pager': $!});
- $CPAN::Frontend->myprint(qq{
-Displaying URL
- $url
-with pager "$pager"
-});
- $CPAN::Frontend->mysleep(1);
- $fh_pager->print(<FH>);
- $fh_pager->close;
- } else {
- # coldn't find the web browser or html converter
- $CPAN::Frontend->myprint(qq{
-You need to install lynx or $html_converter to use this feature.});
- }
- }
-}
-
-#-> sub CPAN::Distribution::_getsave_url ;
-sub _getsave_url {
- my($dist, $shell, $url) = @_;
-
- $CPAN::Frontend->myprint(qq{ + _getsave_url($url)\n})
- if $CPAN::DEBUG;
-
- my($fh,$filename);
- if ($CPAN::META->has_usable("File::Temp")) {
- $fh = File::Temp->new(
- dir => File::Spec->tmpdir,
- template => "cpan_getsave_url_XXXX",
- suffix => ".html",
- unlink => 0,
- );
- $filename = $fh->filename;
- } else {
- $fh = FileHandle->new;
- $filename = "cpan_getsave_url_$$.html";
- }
- my $tmpin = $filename;
- if ($CPAN::META->has_usable('LWP')) {
- $CPAN::Frontend->myprint("Fetching with LWP:
- $url
-");
- my $Ua;
- CPAN::LWP::UserAgent->config;
- eval { $Ua = CPAN::LWP::UserAgent->new; };
- if ($@) {
- $CPAN::Frontend->mywarn("ERROR: CPAN::LWP::UserAgent->new dies with $@\n");
- return;
- } else {
- my($var);
- $Ua->proxy('http', $var)
- if $var = $CPAN::Config->{http_proxy} || $ENV{http_proxy};
- $Ua->no_proxy($var)
- if $var = $CPAN::Config->{no_proxy} || $ENV{no_proxy};
- }
-
- my $req = HTTP::Request->new(GET => $url);
- $req->header('Accept' => 'text/html');
- my $res = $Ua->request($req);
- if ($res->is_success) {
- $CPAN::Frontend->myprint(" + request successful.\n")
- if $CPAN::DEBUG;
- print $fh $res->content;
- close $fh;
- $CPAN::Frontend->myprint(qq{ + saved content to $tmpin \n})
- if $CPAN::DEBUG;
- return $tmpin;
- } else {
- $CPAN::Frontend->myprint(sprintf(
- "LWP failed with code[%s], message[%s]\n",
- $res->code,
- $res->message,
- ));
- return;
- }
- } else {
- $CPAN::Frontend->mywarn(" LWP not available\n");
- return;
- }
-}
-
-#-> sub CPAN::Distribution::_build_command
-sub _build_command {
- my($self) = @_;
- if ($^O eq "MSWin32") { # special code needed at least up to
- # Module::Build 0.2611 and 0.2706; a fix
- # in M:B has been promised 2006-01-30
- my($perl) = $self->perl or $CPAN::Frontend->mydie("Couldn't find executable perl\n");
- return "$perl ./Build";
- }
- return "./Build";
-}
-
-#-> sub CPAN::Distribution::_should_report
-sub _should_report {
- my($self, $phase) = @_;
- die "_should_report() requires a 'phase' argument"
- if ! defined $phase;
-
- # configured
- my $test_report = CPAN::HandleConfig->prefs_lookup($self,
- q{test_report});
- return unless $test_report;
-
- # don't repeat if we cached a result
- return $self->{should_report}
- if exists $self->{should_report};
-
- # available
- if ( ! $CPAN::META->has_inst("CPAN::Reporter")) {
- $CPAN::Frontend->mywarn(
- "CPAN::Reporter not installed. No reports will be sent.\n"
- );
- return $self->{should_report} = 0;
- }
-
- # capable
- my $crv = CPAN::Reporter->VERSION;
- if ( CPAN::Version->vlt( $crv, 0.99 ) ) {
- # don't cache $self->{should_report} -- need to check each phase
- if ( $phase eq 'test' ) {
- return 1;
- }
- else {
- $CPAN::Frontend->mywarn(
- "Reporting on the '$phase' phase requires CPAN::Reporter 0.99, but \n" .
- "you only have version $crv\. Only 'test' phase reports will be sent.\n"
- );
- return;
- }
- }
-
- # appropriate
- if ($self->is_dot_dist) {
- $CPAN::Frontend->mywarn("Reporting via CPAN::Reporter is disabled ".
- "for local directories\n");
- return $self->{should_report} = 0;
- }
- if ($self->prefs->{patches}
- &&
- @{$self->prefs->{patches}}
- &&
- $self->{patched}
- ) {
- $CPAN::Frontend->mywarn("Reporting via CPAN::Reporter is disabled ".
- "when the source has been patched\n");
- return $self->{should_report} = 0;
- }
-
- # proceed and cache success
- return $self->{should_report} = 1;
-}
-
-#-> sub CPAN::Distribution::reports
-sub reports {
- my($self) = @_;
- my $pathname = $self->id;
- $CPAN::Frontend->myprint("Distribution: $pathname\n");
-
- unless ($CPAN::META->has_inst("CPAN::DistnameInfo")) {
- $CPAN::Frontend->mydie("CPAN::DistnameInfo not installed; cannot continue");
- }
- unless ($CPAN::META->has_usable("LWP")) {
- $CPAN::Frontend->mydie("LWP not installed; cannot continue");
- }
- unless ($CPAN::META->has_usable("File::Temp")) {
- $CPAN::Frontend->mydie("File::Temp not installed; cannot continue");
- }
-
- my $d = CPAN::DistnameInfo->new($pathname);
-
- my $dist = $d->dist; # "CPAN-DistnameInfo"
- my $version = $d->version; # "0.02"
- my $maturity = $d->maturity; # "released"
- my $filename = $d->filename; # "CPAN-DistnameInfo-0.02.tar.gz"
- my $cpanid = $d->cpanid; # "GBARR"
- my $distvname = $d->distvname; # "CPAN-DistnameInfo-0.02"
-
- my $url = sprintf "http://cpantesters.perl.org/show/%s.yaml", $dist;
-
- CPAN::LWP::UserAgent->config;
- my $Ua;
- eval { $Ua = CPAN::LWP::UserAgent->new; };
- if ($@) {
- $CPAN::Frontend->mydie("CPAN::LWP::UserAgent->new dies with $@\n");
- }
- $CPAN::Frontend->myprint("Fetching '$url'...");
- my $resp = $Ua->get($url);
- unless ($resp->is_success) {
- $CPAN::Frontend->mydie(sprintf "Could not download '%s': %s\n", $url, $resp->code);
- }
- $CPAN::Frontend->myprint("DONE\n\n");
- my $yaml = $resp->content;
- # was fuer ein Umweg!
- my $fh = File::Temp->new(
- dir => File::Spec->tmpdir,
- template => 'cpan_reports_XXXX',
- suffix => '.yaml',
- unlink => 0,
- );
- my $tfilename = $fh->filename;
- print $fh $yaml;
- close $fh or $CPAN::Frontend->mydie("Could not close '$tfilename': $!");
- my $unserialized = CPAN->_yaml_loadfile($tfilename)->[0];
- unlink $tfilename or $CPAN::Frontend->mydie("Could not unlink '$tfilename': $!");
- my %other_versions;
- my $this_version_seen;
- for my $rep (@$unserialized) {
- my $rversion = $rep->{version};
- if ($rversion eq $version) {
- unless ($this_version_seen++) {
- $CPAN::Frontend->myprint ("$rep->{version}:\n");
- }
- $CPAN::Frontend->myprint
- (sprintf("%1s%1s%-4s %s on %s %s (%s)\n",
- $rep->{archname} eq $Config::Config{archname}?"*":"",
- $rep->{action}eq"PASS"?"+":$rep->{action}eq"FAIL"?"-":"",
- $rep->{action},
- $rep->{perl},
- ucfirst $rep->{osname},
- $rep->{osvers},
- $rep->{archname},
- ));
- } else {
- $other_versions{$rep->{version}}++;
- }
- }
- unless ($this_version_seen) {
- $CPAN::Frontend->myprint("No reports found for version '$version'
-Reports for other versions:\n");
- for my $v (sort keys %other_versions) {
- $CPAN::Frontend->myprint(" $v\: $other_versions{$v}\n");
- }
- }
- $url =~ s/\.yaml/.html/;
- $CPAN::Frontend->myprint("See $url for details\n");
-}
-
-package CPAN::Bundle;
-use strict;
-
-sub look {
- my $self = shift;
- $CPAN::Frontend->myprint($self->as_string);
-}
-
-#-> CPAN::Bundle::undelay
-sub undelay {
- my $self = shift;
- delete $self->{later};
- for my $c ( $self->contains ) {
- my $obj = CPAN::Shell->expandany($c) or next;
- $obj->undelay;
- }
-}
-
-# mark as dirty/clean
-#-> sub CPAN::Bundle::color_cmd_tmps ;
-sub color_cmd_tmps {
- my($self) = shift;
- my($depth) = shift || 0;
- my($color) = shift || 0;
- my($ancestors) = shift || [];
- # a module needs to recurse to its cpan_file, a distribution needs
- # to recurse into its prereq_pms, a bundle needs to recurse into its modules
-
- return if exists $self->{incommandcolor}
- && $color==1
- && $self->{incommandcolor}==$color;
- if ($depth>=$CPAN::MAX_RECURSION) {
- die(CPAN::Exception::RecursiveDependency->new($ancestors));
- }
- # warn "color_cmd_tmps $depth $color " . $self->id; # sleep 1;
-
- for my $c ( $self->contains ) {
- my $obj = CPAN::Shell->expandany($c) or next;
- CPAN->debug("c[$c]obj[$obj]") if $CPAN::DEBUG;
- $obj->color_cmd_tmps($depth+1,$color,[@$ancestors, $self->id]);
- }
- # never reached code?
- #if ($color==0) {
- #delete $self->{badtestcnt};
- #}
- $self->{incommandcolor} = $color;
-}
-
-#-> sub CPAN::Bundle::as_string ;
-sub as_string {
- my($self) = @_;
- $self->contains;
- # following line must be "=", not "||=" because we have a moving target
- $self->{INST_VERSION} = $self->inst_version;
- return $self->SUPER::as_string;
-}
-
-#-> sub CPAN::Bundle::contains ;
-sub contains {
- my($self) = @_;
- my($inst_file) = $self->inst_file || "";
- my($id) = $self->id;
- $self->debug("inst_file[$inst_file]id[$id]") if $CPAN::DEBUG;
- if ($inst_file && CPAN::Version->vlt($self->inst_version,$self->cpan_version)) {
- undef $inst_file;
- }
- unless ($inst_file) {
- # Try to get at it in the cpan directory
- $self->debug("no inst_file") if $CPAN::DEBUG;
- my $cpan_file;
- $CPAN::Frontend->mydie("I don't know a bundle with ID $id\n") unless
- $cpan_file = $self->cpan_file;
- if ($cpan_file eq "N/A") {
- $CPAN::Frontend->mydie("Bundle $id not found on disk and not on CPAN.
- Maybe stale symlink? Maybe removed during session? Giving up.\n");
- }
- my $dist = $CPAN::META->instance('CPAN::Distribution',
- $self->cpan_file);
- $self->debug("before get id[$dist->{ID}]") if $CPAN::DEBUG;
- $dist->get;
- $self->debug("after get id[$dist->{ID}]") if $CPAN::DEBUG;
- my($todir) = $CPAN::Config->{'cpan_home'};
- my(@me,$from,$to,$me);
- @me = split /::/, $self->id;
- $me[-1] .= ".pm";
- $me = File::Spec->catfile(@me);
- $from = $self->find_bundle_file($dist->{build_dir},join('/',@me));
- $to = File::Spec->catfile($todir,$me);
- File::Path::mkpath(File::Basename::dirname($to));
- File::Copy::copy($from, $to)
- or Carp::confess("Couldn't copy $from to $to: $!");
- $inst_file = $to;
- }
- my @result;
- my $fh = FileHandle->new;
- local $/ = "\n";
- open($fh,$inst_file) or die "Could not open '$inst_file': $!";
- my $in_cont = 0;
- $self->debug("inst_file[$inst_file]") if $CPAN::DEBUG;
- while (<$fh>) {
- $in_cont = m/^=(?!head1\s+CONTENTS)/ ? 0 :
- m/^=head1\s+CONTENTS/ ? 1 : $in_cont;
- next unless $in_cont;
- next if /^=/;
- s/\#.*//;
- next if /^\s+$/;
- chomp;
- push @result, (split " ", $_, 2)[0];
- }
- close $fh;
- delete $self->{STATUS};
- $self->{CONTAINS} = \@result;
- $self->debug("CONTAINS[@result]") if $CPAN::DEBUG;
- unless (@result) {
- $CPAN::Frontend->mywarn(qq{
-The bundle file "$inst_file" may be a broken
-bundlefile. It seems not to contain any bundle definition.
-Please check the file and if it is bogus, please delete it.
-Sorry for the inconvenience.
-});
- }
- @result;
-}
-
-#-> sub CPAN::Bundle::find_bundle_file
-# $where is in local format, $what is in unix format
-sub find_bundle_file {
- my($self,$where,$what) = @_;
- $self->debug("where[$where]what[$what]") if $CPAN::DEBUG;
-### The following two lines let CPAN.pm become Bundle/CPAN.pm :-(
-### my $bu = File::Spec->catfile($where,$what);
-### return $bu if -f $bu;
- my $manifest = File::Spec->catfile($where,"MANIFEST");
- unless (-f $manifest) {
- require ExtUtils::Manifest;
- my $cwd = CPAN::anycwd();
- $self->safe_chdir($where);
- ExtUtils::Manifest::mkmanifest();
- $self->safe_chdir($cwd);
- }
- my $fh = FileHandle->new($manifest)
- or Carp::croak("Couldn't open $manifest: $!");
- local($/) = "\n";
- my $bundle_filename = $what;
- $bundle_filename =~ s|Bundle.*/||;
- my $bundle_unixpath;
- while (<$fh>) {
- next if /^\s*\#/;
- my($file) = /(\S+)/;
- if ($file =~ m|\Q$what\E$|) {
- $bundle_unixpath = $file;
- # return File::Spec->catfile($where,$bundle_unixpath); # bad
- last;
- }
- # retry if she managed to have no Bundle directory
- $bundle_unixpath = $file if $file =~ m|\Q$bundle_filename\E$|;
- }
- return File::Spec->catfile($where, split /\//, $bundle_unixpath)
- if $bundle_unixpath;
- Carp::croak("Couldn't find a Bundle file in $where");
-}
-
-# needs to work quite differently from Module::inst_file because of
-# cpan_home/Bundle/ directory and the possibility that we have
-# shadowing effect. As it makes no sense to take the first in @INC for
-# Bundles, we parse them all for $VERSION and take the newest.
-
-#-> sub CPAN::Bundle::inst_file ;
-sub inst_file {
- my($self) = @_;
- my($inst_file);
- my(@me);
- @me = split /::/, $self->id;
- $me[-1] .= ".pm";
- my($incdir,$bestv);
- foreach $incdir ($CPAN::Config->{'cpan_home'},@INC) {
- my $bfile = File::Spec->catfile($incdir, @me);
- CPAN->debug("bfile[$bfile]") if $CPAN::DEBUG;
- next unless -f $bfile;
- my $foundv = MM->parse_version($bfile);
- if (!$bestv || CPAN::Version->vgt($foundv,$bestv)) {
- $self->{INST_FILE} = $bfile;
- $self->{INST_VERSION} = $bestv = $foundv;
- }
- }
- $self->{INST_FILE};
-}
-
-#-> sub CPAN::Bundle::inst_version ;
-sub inst_version {
- my($self) = @_;
- $self->inst_file; # finds INST_VERSION as side effect
- $self->{INST_VERSION};
-}
-
-#-> sub CPAN::Bundle::rematein ;
-sub rematein {
- my($self,$meth) = @_;
- $self->debug("self[$self] meth[$meth]") if $CPAN::DEBUG;
- my($id) = $self->id;
- Carp::croak "Can't $meth $id, don't have an associated bundle file. :-(\n"
- unless $self->inst_file || $self->cpan_file;
- my($s,%fail);
- for $s ($self->contains) {
- my($type) = $s =~ m|/| ? 'CPAN::Distribution' :
- $s =~ m|^Bundle::| ? 'CPAN::Bundle' : 'CPAN::Module';
- if ($type eq 'CPAN::Distribution') {
- $CPAN::Frontend->mywarn(qq{
-The Bundle }.$self->id.qq{ contains
-explicitly a file '$s'.
-Going to $meth that.
-});
- $CPAN::Frontend->mysleep(5);
- }
- # possibly noisy action:
- $self->debug("type[$type] s[$s]") if $CPAN::DEBUG;
- my $obj = $CPAN::META->instance($type,$s);
- $obj->{reqtype} = $self->{reqtype};
- $obj->$meth();
- }
-}
-
-# If a bundle contains another that contains an xs_file we have here,
-# we just don't bother I suppose
-#-> sub CPAN::Bundle::xs_file
-sub xs_file {
- return 0;
-}
-
-#-> sub CPAN::Bundle::force ;
-sub fforce { shift->rematein('fforce',@_); }
-#-> sub CPAN::Bundle::force ;
-sub force { shift->rematein('force',@_); }
-#-> sub CPAN::Bundle::notest ;
-sub notest { shift->rematein('notest',@_); }
-#-> sub CPAN::Bundle::get ;
-sub get { shift->rematein('get',@_); }
-#-> sub CPAN::Bundle::make ;
-sub make { shift->rematein('make',@_); }
-#-> sub CPAN::Bundle::test ;
-sub test {
- my $self = shift;
- # $self->{badtestcnt} ||= 0;
- $self->rematein('test',@_);
-}
-#-> sub CPAN::Bundle::install ;
-sub install {
- my $self = shift;
- $self->rematein('install',@_);
-}
-#-> sub CPAN::Bundle::clean ;
-sub clean { shift->rematein('clean',@_); }
-
-#-> sub CPAN::Bundle::uptodate ;
-sub uptodate {
- my($self) = @_;
- return 0 unless $self->SUPER::uptodate; # we mut have the current Bundle def
- my $c;
- foreach $c ($self->contains) {
- my $obj = CPAN::Shell->expandany($c);
- return 0 unless $obj->uptodate;
- }
- return 1;
-}
-
-#-> sub CPAN::Bundle::readme ;
-sub readme {
- my($self) = @_;
- my($file) = $self->cpan_file or $CPAN::Frontend->myprint(qq{
-No File found for bundle } . $self->id . qq{\n}), return;
- $self->debug("self[$self] file[$file]") if $CPAN::DEBUG;
- $CPAN::META->instance('CPAN::Distribution',$file)->readme;
-}
-
-package CPAN::Module;
-use strict;
-
-# Accessors
-#-> sub CPAN::Module::userid
-sub userid {
- my $self = shift;
- my $ro = $self->ro;
- return unless $ro;
- return $ro->{userid} || $ro->{CPAN_USERID};
-}
-#-> sub CPAN::Module::description
-sub description {
- my $self = shift;
- my $ro = $self->ro or return "";
- $ro->{description}
-}
-
-#-> sub CPAN::Module::distribution
-sub distribution {
- my($self) = @_;
- CPAN::Shell->expand("Distribution",$self->cpan_file);
-}
-
-#-> sub CPAN::Module::undelay
-sub undelay {
- my $self = shift;
- delete $self->{later};
- if ( my $dist = CPAN::Shell->expand("Distribution", $self->cpan_file) ) {
- $dist->undelay;
- }
-}
-
-# mark as dirty/clean
-#-> sub CPAN::Module::color_cmd_tmps ;
-sub color_cmd_tmps {
- my($self) = shift;
- my($depth) = shift || 0;
- my($color) = shift || 0;
- my($ancestors) = shift || [];
- # a module needs to recurse to its cpan_file
-
- return if exists $self->{incommandcolor}
- && $color==1
- && $self->{incommandcolor}==$color;
- return if $color==0 && !$self->{incommandcolor};
- if ($color>=1) {
- if ( $self->uptodate ) {
- $self->{incommandcolor} = $color;
- return;
- } elsif (my $have_version = $self->available_version) {
- # maybe what we have is good enough
- if (@$ancestors) {
- my $who_asked_for_me = $ancestors->[-1];
- my $obj = CPAN::Shell->expandany($who_asked_for_me);
- if (0) {
- } elsif ($obj->isa("CPAN::Bundle")) {
- # bundles cannot specify a minimum version
- return;
- } elsif ($obj->isa("CPAN::Distribution")) {
- if (my $prereq_pm = $obj->prereq_pm) {
- for my $k (keys %$prereq_pm) {
- if (my $want_version = $prereq_pm->{$k}{$self->id}) {
- if (CPAN::Version->vcmp($have_version,$want_version) >= 0) {
- $self->{incommandcolor} = $color;
- return;
- }
- }
- }
- }
- }
- }
- }
- } else {
- $self->{incommandcolor} = $color; # set me before recursion,
- # so we can break it
- }
- if ($depth>=$CPAN::MAX_RECURSION) {
- die(CPAN::Exception::RecursiveDependency->new($ancestors));
- }
- # warn "color_cmd_tmps $depth $color " . $self->id; # sleep 1;
-
- if ( my $dist = CPAN::Shell->expand("Distribution", $self->cpan_file) ) {
- $dist->color_cmd_tmps($depth+1,$color,[@$ancestors, $self->id]);
- }
- # unreached code?
- # if ($color==0) {
- # delete $self->{badtestcnt};
- # }
- $self->{incommandcolor} = $color;
-}
-
-#-> sub CPAN::Module::as_glimpse ;
-sub as_glimpse {
- my($self) = @_;
- my(@m);
- my $class = ref($self);
- $class =~ s/^CPAN:://;
- my $color_on = "";
- my $color_off = "";
- if (
- $CPAN::Shell::COLOR_REGISTERED
- &&
- $CPAN::META->has_inst("Term::ANSIColor")
- &&
- $self->description
- ) {
- $color_on = Term::ANSIColor::color("green");
- $color_off = Term::ANSIColor::color("reset");
- }
- my $uptodateness = " ";
- unless ($class eq "Bundle") {
- my $u = $self->uptodate;
- $uptodateness = $u ? "=" : "<" if defined $u;
- };
- my $id = do {
- my $d = $self->distribution;
- $d ? $d -> pretty_id : $self->cpan_userid;
- };
- push @m, sprintf("%-7s %1s %s%-22s%s (%s)\n",
- $class,
- $uptodateness,
- $color_on,
- $self->id,
- $color_off,
- $id,
- );
- join "", @m;
-}
-
-#-> sub CPAN::Module::dslip_status
-sub dslip_status {
- my($self) = @_;
- my($stat);
- # development status
- @{$stat->{D}}{qw,i c a b R M S,} = qw,idea
- pre-alpha alpha beta released
- mature standard,;
- # support level
- @{$stat->{S}}{qw,m d u n a,} = qw,mailing-list
- developer comp.lang.perl.*
- none abandoned,;
- # language
- @{$stat->{L}}{qw,p c + o h,} = qw,perl C C++ other hybrid,;
- # interface
- @{$stat->{I}}{qw,f r O p h n,} = qw,functions
- references+ties
- object-oriented pragma
- hybrid none,;
- # public licence
- @{$stat->{P}}{qw,p g l b a 2 o d r n,} = qw,Standard-Perl
- GPL LGPL
- BSD Artistic Artistic_2
- open-source
- distribution_allowed
- restricted_distribution
- no_licence,;
- for my $x (qw(d s l i p)) {
- $stat->{$x}{' '} = 'unknown';
- $stat->{$x}{'?'} = 'unknown';
- }
- my $ro = $self->ro;
- return +{} unless $ro && $ro->{statd};
- return {
- D => $ro->{statd},
- S => $ro->{stats},
- L => $ro->{statl},
- I => $ro->{stati},
- P => $ro->{statp},
- DV => $stat->{D}{$ro->{statd}},
- SV => $stat->{S}{$ro->{stats}},
- LV => $stat->{L}{$ro->{statl}},
- IV => $stat->{I}{$ro->{stati}},
- PV => $stat->{P}{$ro->{statp}},
- };
-}
-
-#-> sub CPAN::Module::as_string ;
-sub as_string {
- my($self) = @_;
- my(@m);
- CPAN->debug("$self entering as_string") if $CPAN::DEBUG;
- my $class = ref($self);
- $class =~ s/^CPAN:://;
- local($^W) = 0;
- push @m, $class, " id = $self->{ID}\n";
- my $sprintf = " %-12s %s\n";
- push @m, sprintf($sprintf, 'DESCRIPTION', $self->description)
- if $self->description;
- my $sprintf2 = " %-12s %s (%s)\n";
- my($userid);
- $userid = $self->userid;
- if ( $userid ) {
- my $author;
- if ($author = CPAN::Shell->expand('Author',$userid)) {
- my $email = "";
- my $m; # old perls
- if ($m = $author->email) {
- $email = " <$m>";
- }
- push @m, sprintf(
- $sprintf2,
- 'CPAN_USERID',
- $userid,
- $author->fullname . $email
- );
- }
- }
- push @m, sprintf($sprintf, 'CPAN_VERSION', $self->cpan_version)
- if $self->cpan_version;
- if (my $cpan_file = $self->cpan_file) {
- push @m, sprintf($sprintf, 'CPAN_FILE', $cpan_file);
- if (my $dist = CPAN::Shell->expand("Distribution",$cpan_file)) {
- my $upload_date = $dist->upload_date;
- if ($upload_date) {
- push @m, sprintf($sprintf, 'UPLOAD_DATE', $upload_date);
- }
- }
- }
- my $sprintf3 = " %-12s %1s%1s%1s%1s%1s (%s,%s,%s,%s,%s)\n";
- my $dslip = $self->dslip_status;
- push @m, sprintf(
- $sprintf3,
- 'DSLIP_STATUS',
- @{$dslip}{qw(D S L I P DV SV LV IV PV)},
- ) if $dslip->{D};
- my $local_file = $self->inst_file;
- unless ($self->{MANPAGE}) {
- my $manpage;
- if ($local_file) {
- $manpage = $self->manpage_headline($local_file);
- } else {
- # If we have already untarred it, we should look there
- my $dist = $CPAN::META->instance('CPAN::Distribution',
- $self->cpan_file);
- # warn "dist[$dist]";
- # mff=manifest file; mfh=manifest handle
- my($mff,$mfh);
- if (
- $dist->{build_dir}
- and
- (-f ($mff = File::Spec->catfile($dist->{build_dir}, "MANIFEST")))
- and
- $mfh = FileHandle->new($mff)
- ) {
- CPAN->debug("mff[$mff]") if $CPAN::DEBUG;
- my $lfre = $self->id; # local file RE
- $lfre =~ s/::/./g;
- $lfre .= "\\.pm\$";
- my($lfl); # local file file
- local $/ = "\n";
- my(@mflines) = <$mfh>;
- for (@mflines) {
- s/^\s+//;
- s/\s.*//s;
- }
- while (length($lfre)>5 and !$lfl) {
- ($lfl) = grep /$lfre/, @mflines;
- CPAN->debug("lfl[$lfl]lfre[$lfre]") if $CPAN::DEBUG;
- $lfre =~ s/.+?\.//;
- }
- $lfl =~ s/\s.*//; # remove comments
- $lfl =~ s/\s+//g; # chomp would maybe be too system-specific
- my $lfl_abs = File::Spec->catfile($dist->{build_dir},$lfl);
- # warn "lfl_abs[$lfl_abs]";
- if (-f $lfl_abs) {
- $manpage = $self->manpage_headline($lfl_abs);
- }
- }
- }
- $self->{MANPAGE} = $manpage if $manpage;
- }
- my($item);
- for $item (qw/MANPAGE/) {
- push @m, sprintf($sprintf, $item, $self->{$item})
- if exists $self->{$item};
- }
- for $item (qw/CONTAINS/) {
- push @m, sprintf($sprintf, $item, join(" ",@{$self->{$item}}))
- if exists $self->{$item} && @{$self->{$item}};
- }
- push @m, sprintf($sprintf, 'INST_FILE',
- $local_file || "(not installed)");
- push @m, sprintf($sprintf, 'INST_VERSION',
- $self->inst_version) if $local_file;
- join "", @m, "\n";
-}
-
-#-> sub CPAN::Module::manpage_headline
-sub manpage_headline {
- my($self,$local_file) = @_;
- my(@local_file) = $local_file;
- $local_file =~ s/\.pm(?!\n)\Z/.pod/;
- push @local_file, $local_file;
- my(@result,$locf);
- for $locf (@local_file) {
- next unless -f $locf;
- my $fh = FileHandle->new($locf)
- or $Carp::Frontend->mydie("Couldn't open $locf: $!");
- my $inpod = 0;
- local $/ = "\n";
- while (<$fh>) {
- $inpod = m/^=(?!head1\s+NAME\s*$)/ ? 0 :
- m/^=head1\s+NAME\s*$/ ? 1 : $inpod;
- next unless $inpod;
- next if /^=/;
- next if /^\s+$/;
- chomp;
- push @result, $_;
- }
- close $fh;
- last if @result;
- }
- for (@result) {
- s/^\s+//;
- s/\s+$//;
- }
- join " ", @result;
-}
-
-#-> sub CPAN::Module::cpan_file ;
-# Note: also inherited by CPAN::Bundle
-sub cpan_file {
- my $self = shift;
- # CPAN->debug(sprintf "id[%s]", $self->id) if $CPAN::DEBUG;
- unless ($self->ro) {
- CPAN::Index->reload;
- }
- my $ro = $self->ro;
- if ($ro && defined $ro->{CPAN_FILE}) {
- return $ro->{CPAN_FILE};
- } else {
- my $userid = $self->userid;
- if ( $userid ) {
- if ($CPAN::META->exists("CPAN::Author",$userid)) {
- my $author = $CPAN::META->instance("CPAN::Author",
- $userid);
- my $fullname = $author->fullname;
- my $email = $author->email;
- unless (defined $fullname && defined $email) {
- return sprintf("Contact Author %s",
- $userid,
- );
- }
- return "Contact Author $fullname <$email>";
- } else {
- return "Contact Author $userid (Email address not available)";
- }
- } else {
- return "N/A";
- }
- }
-}
-
-#-> sub CPAN::Module::cpan_version ;
-sub cpan_version {
- my $self = shift;
-
- my $ro = $self->ro;
- unless ($ro) {
- # Can happen with modules that are not on CPAN
- $ro = {};
- }
- $ro->{CPAN_VERSION} = 'undef'
- unless defined $ro->{CPAN_VERSION};
- $ro->{CPAN_VERSION};
-}
-
-#-> sub CPAN::Module::force ;
-sub force {
- my($self) = @_;
- $self->{force_update} = 1;
-}
-
-#-> sub CPAN::Module::fforce ;
-sub fforce {
- my($self) = @_;
- $self->{force_update} = 2;
-}
-
-#-> sub CPAN::Module::notest ;
-sub notest {
- my($self) = @_;
- # $CPAN::Frontend->mywarn("XDEBUG: set notest for Module");
- $self->{notest}++;
-}
-
-#-> sub CPAN::Module::rematein ;
-sub rematein {
- my($self,$meth) = @_;
- $CPAN::Frontend->myprint(sprintf("Running %s for module '%s'\n",
- $meth,
- $self->id));
- my $cpan_file = $self->cpan_file;
- if ($cpan_file eq "N/A" || $cpan_file =~ /^Contact Author/) {
- $CPAN::Frontend->mywarn(sprintf qq{
- The module %s isn\'t available on CPAN.
-
- Either the module has not yet been uploaded to CPAN, or it is
- temporary unavailable. Please contact the author to find out
- more about the status. Try 'i %s'.
-},
- $self->id,
- $self->id,
- );
- return;
- }
- my $pack = $CPAN::META->instance('CPAN::Distribution',$cpan_file);
- $pack->called_for($self->id);
- if (exists $self->{force_update}) {
- if ($self->{force_update} == 2) {
- $pack->fforce($meth);
- } else {
- $pack->force($meth);
- }
- }
- $pack->notest($meth) if exists $self->{notest} && $self->{notest};
-
- $pack->{reqtype} ||= "";
- CPAN->debug("dist-reqtype[$pack->{reqtype}]".
- "self-reqtype[$self->{reqtype}]") if $CPAN::DEBUG;
- if ($pack->{reqtype}) {
- if ($pack->{reqtype} eq "b" && $self->{reqtype} =~ /^[rc]$/) {
- $pack->{reqtype} = $self->{reqtype};
- if (
- exists $pack->{install}
- &&
- (
- UNIVERSAL::can($pack->{install},"failed") ?
- $pack->{install}->failed :
- $pack->{install} =~ /^NO/
- )
- ) {
- delete $pack->{install};
- $CPAN::Frontend->mywarn
- ("Promoting $pack->{ID} from 'build_requires' to 'requires'");
- }
- }
- } else {
- $pack->{reqtype} = $self->{reqtype};
- }
-
- my $success = eval {
- $pack->$meth();
- };
- my $err = $@;
- $pack->unforce if $pack->can("unforce") && exists $self->{force_update};
- $pack->unnotest if $pack->can("unnotest") && exists $self->{notest};
- delete $self->{force_update};
- delete $self->{notest};
- if ($err) {
- die $err;
- }
- return $success;
-}
-
-#-> sub CPAN::Module::perldoc ;
-sub perldoc { shift->rematein('perldoc') }
-#-> sub CPAN::Module::readme ;
-sub readme { shift->rematein('readme') }
-#-> sub CPAN::Module::look ;
-sub look { shift->rematein('look') }
-#-> sub CPAN::Module::cvs_import ;
-sub cvs_import { shift->rematein('cvs_import') }
-#-> sub CPAN::Module::get ;
-sub get { shift->rematein('get',@_) }
-#-> sub CPAN::Module::make ;
-sub make { shift->rematein('make') }
-#-> sub CPAN::Module::test ;
-sub test {
- my $self = shift;
- # $self->{badtestcnt} ||= 0;
- $self->rematein('test',@_);
-}
-
-#-> sub CPAN::Module::uptodate ;
-sub uptodate {
- my ($self) = @_;
- local ($_);
- my $inst = $self->inst_version or return undef;
- my $cpan = $self->cpan_version;
- local ($^W) = 0;
- CPAN::Version->vgt($cpan,$inst) and return 0;
- CPAN->debug(join("",
- "returning uptodate. inst_file[",
- $self->inst_file,
- "cpan[$cpan] inst[$inst]")) if $CPAN::DEBUG;
- return 1;
-}
-
-#-> sub CPAN::Module::install ;
-sub install {
- my($self) = @_;
- my($doit) = 0;
- if ($self->uptodate
- &&
- not exists $self->{force_update}
- ) {
- $CPAN::Frontend->myprint(sprintf("%s is up to date (%s).\n",
- $self->id,
- $self->inst_version,
- ));
- } else {
- $doit = 1;
- }
- my $ro = $self->ro;
- if ($ro && $ro->{stats} && $ro->{stats} eq "a") {
- $CPAN::Frontend->mywarn(qq{
-\n\n\n ***WARNING***
- The module $self->{ID} has no active maintainer.\n\n\n
-});
- $CPAN::Frontend->mysleep(5);
- }
- $self->rematein('install') if $doit;
-}
-#-> sub CPAN::Module::clean ;
-sub clean { shift->rematein('clean') }
-
-#-> sub CPAN::Module::inst_file ;
-sub inst_file {
- my($self) = @_;
- $self->_file_in_path([@INC]);
-}
-
-#-> sub CPAN::Module::available_file ;
-sub available_file {
- my($self) = @_;
- my $sep = $Config::Config{path_sep};
- my $perllib = $ENV{PERL5LIB};
- $perllib = $ENV{PERLLIB} unless defined $perllib;
- my @perllib = split(/$sep/,$perllib) if defined $perllib;
- $self->_file_in_path([@perllib,@INC]);
-}
-
-#-> sub CPAN::Module::file_in_path ;
-sub _file_in_path {
- my($self,$path) = @_;
- my($dir,@packpath);
- @packpath = split /::/, $self->{ID};
- $packpath[-1] .= ".pm";
- if (@packpath == 1 && $packpath[0] eq "readline.pm") {
- unshift @packpath, "Term", "ReadLine"; # historical reasons
- }
- foreach $dir (@$path) {
- my $pmfile = File::Spec->catfile($dir,@packpath);
- if (-f $pmfile) {
- return $pmfile;
- }
- }
- return;
-}
-
-#-> sub CPAN::Module::xs_file ;
-sub xs_file {
- my($self) = @_;
- my($dir,@packpath);
- @packpath = split /::/, $self->{ID};
- push @packpath, $packpath[-1];
- $packpath[-1] .= "." . $Config::Config{'dlext'};
- foreach $dir (@INC) {
- my $xsfile = File::Spec->catfile($dir,'auto',@packpath);
- if (-f $xsfile) {
- return $xsfile;
- }
- }
- return;
-}
-
-#-> sub CPAN::Module::inst_version ;
-sub inst_version {
- my($self) = @_;
- my $parsefile = $self->inst_file or return;
- my $have = $self->parse_version($parsefile);
- $have;
-}
-
-#-> sub CPAN::Module::inst_version ;
-sub available_version {
- my($self) = @_;
- my $parsefile = $self->available_file or return;
- my $have = $self->parse_version($parsefile);
- $have;
-}
-
-#-> sub CPAN::Module::parse_version ;
-sub parse_version {
- my($self,$parsefile) = @_;
- my $have = MM->parse_version($parsefile);
- $have = "undef" unless defined $have && length $have;
- $have =~ s/^ //; # since the %vd hack these two lines here are needed
- $have =~ s/ $//; # trailing whitespace happens all the time
-
- $have = CPAN::Version->readable($have);
-
- $have =~ s/\s*//g; # stringify to float around floating point issues
- $have; # no stringify needed, \s* above matches always
-}
-
-#-> sub CPAN::Module::reports
-sub reports {
- my($self) = @_;
- $self->distribution->reports;
-}
-
-package CPAN;
-use strict;
-
-1;
-
-
-__END__
-
-=head1 NAME
-
-CPAN - query, download and build perl modules from CPAN sites
-
-=head1 SYNOPSIS
-
-Interactive mode:
-
- perl -MCPAN -e shell
-
---or--
-
- cpan
-
-Basic commands:
-
- # Modules:
-
- cpan> install Acme::Meta # in the shell
-
- CPAN::Shell->install("Acme::Meta"); # in perl
-
- # Distributions:
-
- cpan> install NWCLARK/Acme-Meta-0.02.tar.gz # in the shell
-
- CPAN::Shell->
- install("NWCLARK/Acme-Meta-0.02.tar.gz"); # in perl
-
- # module objects:
-
- $mo = CPAN::Shell->expandany($mod);
- $mo = CPAN::Shell->expand("Module",$mod); # same thing
-
- # distribution objects:
-
- $do = CPAN::Shell->expand("Module",$mod)->distribution;
- $do = CPAN::Shell->expandany($distro); # same thing
- $do = CPAN::Shell->expand("Distribution",
- $distro); # same thing
-
-=head1 DESCRIPTION
-
-The CPAN module automates or at least simplifies the make and install
-of perl modules and extensions. It includes some primitive searching
-capabilities and knows how to use Net::FTP or LWP or some external
-download clients to fetch the distributions from the net.
-
-These are fetched from one or more of the mirrored CPAN (Comprehensive
-Perl Archive Network) sites and unpacked in a dedicated directory.
-
-The CPAN module also supports the concept of named and versioned
-I<bundles> of modules. Bundles simplify the handling of sets of
-related modules. See Bundles below.
-
-The package contains a session manager and a cache manager. The
-session manager keeps track of what has been fetched, built and
-installed in the current session. The cache manager keeps track of the
-disk space occupied by the make processes and deletes excess space
-according to a simple FIFO mechanism.
-
-All methods provided are accessible in a programmer style and in an
-interactive shell style.
-
-=head2 CPAN::shell([$prompt, $command]) Starting Interactive Mode
-
-The interactive mode is entered by running
-
- perl -MCPAN -e shell
-
-or
-
- cpan
-
-which puts you into a readline interface. If C<Term::ReadKey> and
-either C<Term::ReadLine::Perl> or C<Term::ReadLine::Gnu> are installed
-it supports both history and command completion.
-
-Once you are on the command line, type C<h> to get a one page help
-screen and the rest should be self-explanatory.
-
-The function call C<shell> takes two optional arguments, one is the
-prompt, the second is the default initial command line (the latter
-only works if a real ReadLine interface module is installed).
-
-The most common uses of the interactive modes are
-
-=over 2
-
-=item Searching for authors, bundles, distribution files and modules
-
-There are corresponding one-letter commands C<a>, C<b>, C<d>, and C<m>
-for each of the four categories and another, C<i> for any of the
-mentioned four. Each of the four entities is implemented as a class
-with slightly differing methods for displaying an object.
-
-Arguments you pass to these commands are either strings exactly matching
-the identification string of an object or regular expressions that are
-then matched case-insensitively against various attributes of the
-objects. The parser recognizes a regular expression only if you
-enclose it between two slashes.
-
-The principle is that the number of found objects influences how an
-item is displayed. If the search finds one item, the result is
-displayed with the rather verbose method C<as_string>, but if we find
-more than one, we display each object with the terse method
-C<as_glimpse>.
-
-=item C<get>, C<make>, C<test>, C<install>, C<clean> modules or distributions
-
-These commands take any number of arguments and investigate what is
-necessary to perform the action. If the argument is a distribution
-file name (recognized by embedded slashes), it is processed. If it is
-a module, CPAN determines the distribution file in which this module
-is included and processes that, following any dependencies named in
-the module's META.yml or Makefile.PL (this behavior is controlled by
-the configuration parameter C<prerequisites_policy>.)
-
-C<get> downloads a distribution file and untars or unzips it, C<make>
-builds it, C<test> runs the test suite, and C<install> installs it.
-
-Any C<make> or C<test> are run unconditionally. An
-
- install <distribution_file>
-
-also is run unconditionally. But for
-
- install <module>
-
-CPAN checks if an install is actually needed for it and prints
-I<module up to date> in the case that the distribution file containing
-the module doesn't need to be updated.
-
-CPAN also keeps track of what it has done within the current session
-and doesn't try to build a package a second time regardless if it
-succeeded or not. It does not repeat a test run if the test
-has been run successfully before. Same for install runs.
-
-The C<force> pragma may precede another command (currently: C<get>,
-C<make>, C<test>, or C<install>) and executes the command from scratch
-and tries to continue in case of some errors. See the section below on
-the C<force> and the C<fforce> pragma.
-
-The C<notest> pragma may be used to skip the test part in the build
-process.
-
-Example:
-
- cpan> notest install Tk
-
-A C<clean> command results in a
-
- make clean
-
-being executed within the distribution file's working directory.
-
-=item C<readme>, C<perldoc>, C<look> module or distribution
-
-C<readme> displays the README file of the associated distribution.
-C<Look> gets and untars (if not yet done) the distribution file,
-changes to the appropriate directory and opens a subshell process in
-that directory. C<perldoc> displays the pod documentation of the
-module in html or plain text format.
-
-=item C<ls> author
-
-=item C<ls> globbing_expression
-
-The first form lists all distribution files in and below an author's
-CPAN directory as they are stored in the CHECKUMS files distributed on
-CPAN. The listing goes recursive into all subdirectories.
-
-The second form allows to limit or expand the output with shell
-globbing as in the following examples:
-
- ls JV/make*
- ls GSAR/*make*
- ls */*make*
-
-The last example is very slow and outputs extra progress indicators
-that break the alignment of the result.
-
-Note that globbing only lists directories explicitly asked for, for
-example FOO/* will not list FOO/bar/Acme-Sthg-n.nn.tar.gz. This may be
-regarded as a bug and may be changed in future versions.
-
-=item C<failed>
-
-The C<failed> command reports all distributions that failed on one of
-C<make>, C<test> or C<install> for some reason in the currently
-running shell session.
-
-=item Persistence between sessions
-
-If the C<YAML> or the C<YAML::Syck> module is installed a record of
-the internal state of all modules is written to disk after each step.
-The files contain a signature of the currently running perl version
-for later perusal.
-
-If the configurations variable C<build_dir_reuse> is set to a true
-value, then CPAN.pm reads the collected YAML files. If the stored
-signature matches the currently running perl the stored state is
-loaded into memory such that effectively persistence between sessions
-is established.
-
-=item The C<force> and the C<fforce> pragma
-
-To speed things up in complex installation scenarios, CPAN.pm keeps
-track of what it has already done and refuses to do some things a
-second time. A C<get>, a C<make>, and an C<install> are not repeated.
-A C<test> is only repeated if the previous test was unsuccessful. The
-diagnostic message when CPAN.pm refuses to do something a second time
-is one of I<Has already been >C<unwrapped|made|tested successfully> or
-something similar. Another situation where CPAN refuses to act is an
-C<install> if the according C<test> was not successful.
-
-In all these cases, the user can override the goatish behaviour by
-prepending the command with the word force, for example:
-
- cpan> force get Foo
- cpan> force make AUTHOR/Bar-3.14.tar.gz
- cpan> force test Baz
- cpan> force install Acme::Meta
-
-Each I<forced> command is executed with the according part of its
-memory erased.
-
-The C<fforce> pragma is a variant that emulates a C<force get> which
-erases the entire memory followed by the action specified, effectively
-restarting the whole get/make/test/install procedure from scratch.
-
-=item Lockfile
-
-Interactive sessions maintain a lockfile, per default C<~/.cpan/.lock>.
-Batch jobs can run without a lockfile and do not disturb each other.
-
-The shell offers to run in I<degraded mode> when another process is
-holding the lockfile. This is an experimental feature that is not yet
-tested very well. This second shell then does not write the history
-file, does not use the metadata file and has a different prompt.
-
-=item Signals
-
-CPAN.pm installs signal handlers for SIGINT and SIGTERM. While you are
-in the cpan-shell it is intended that you can press C<^C> anytime and
-return to the cpan-shell prompt. A SIGTERM will cause the cpan-shell
-to clean up and leave the shell loop. You can emulate the effect of a
-SIGTERM by sending two consecutive SIGINTs, which usually means by
-pressing C<^C> twice.
-
-CPAN.pm ignores a SIGPIPE. If the user sets C<inactivity_timeout>, a
-SIGALRM is used during the run of the C<perl Makefile.PL> or C<perl
-Build.PL> subprocess.
-
-=back
-
-=head2 CPAN::Shell
-
-The commands that are available in the shell interface are methods in
-the package CPAN::Shell. If you enter the shell command, all your
-input is split by the Text::ParseWords::shellwords() routine which
-acts like most shells do. The first word is being interpreted as the
-method to be called and the rest of the words are treated as arguments
-to this method. Continuation lines are supported if a line ends with a
-literal backslash.
-
-=head2 autobundle
-
-C<autobundle> writes a bundle file into the
-C<$CPAN::Config-E<gt>{cpan_home}/Bundle> directory. The file contains
-a list of all modules that are both available from CPAN and currently
-installed within @INC. The name of the bundle file is based on the
-current date and a counter.
-
-=head2 hosts
-
-Note: this feature is still in alpha state and may change in future
-versions of CPAN.pm
-
-This commands provides a statistical overview over recent download
-activities. The data for this is collected in the YAML file
-C<FTPstats.yml> in your C<cpan_home> directory. If no YAML module is
-configured or YAML not installed, then no stats are provided.
-
-=head2 mkmyconfig
-
-mkmyconfig() writes your own CPAN::MyConfig file into your ~/.cpan/
-directory so that you can save your own preferences instead of the
-system wide ones.
-
-=head2 recent ***EXPERIMENTAL COMMAND***
-
-The C<recent> command downloads a list of recent uploads to CPAN and
-displays them I<slowly>. While the command is running $SIG{INT} is
-defined to mean that the loop shall be left after having displayed the
-current item.
-
-B<Note>: This command requires XML::LibXML installed.
-
-B<Note>: This whole command currently is a bit klunky and will
-probably change in future versions of CPAN.pm but the general
-approach will likely stay.
-
-B<Note>: See also L<smoke>
-
-=head2 recompile
-
-recompile() is a very special command in that it takes no argument and
-runs the make/test/install cycle with brute force over all installed
-dynamically loadable extensions (aka XS modules) with 'force' in
-effect. The primary purpose of this command is to finish a network
-installation. Imagine, you have a common source tree for two different
-architectures. You decide to do a completely independent fresh
-installation. You start on one architecture with the help of a Bundle
-file produced earlier. CPAN installs the whole Bundle for you, but
-when you try to repeat the job on the second architecture, CPAN
-responds with a C<"Foo up to date"> message for all modules. So you
-invoke CPAN's recompile on the second architecture and you're done.
-
-Another popular use for C<recompile> is to act as a rescue in case your
-perl breaks binary compatibility. If one of the modules that CPAN uses
-is in turn depending on binary compatibility (so you cannot run CPAN
-commands), then you should try the CPAN::Nox module for recovery.
-
-=head2 report Bundle|Distribution|Module
-
-The C<report> command temporarily turns on the C<test_report> config
-variable, then runs the C<force test> command with the given
-arguments. The C<force> pragma is used to re-run the tests and repeat
-every step that might have failed before.
-
-=head2 smoke ***EXPERIMENTAL COMMAND***
-
-B<*** WARNING: this command downloads and executes software from CPAN to
-your computer of completely unknown status. You should never do
-this with your normal account and better have a dedicated well
-separated and secured machine to do this. ***>
-
-The C<smoke> command takes the list of recent uploads to CPAN as
-provided by the C<recent> command and tests them all. While the
-command is running $SIG{INT} is defined to mean that the current item
-shall be skipped.
-
-B<Note>: This whole command currently is a bit klunky and will
-probably change in future versions of CPAN.pm but the general
-approach will likely stay.
-
-B<Note>: See also L<recent>
-
-=head2 upgrade [Module|/Regex/]...
-
-The C<upgrade> command first runs an C<r> command with the given
-arguments and then installs the newest versions of all modules that
-were listed by that.
-
-=head2 The four C<CPAN::*> Classes: Author, Bundle, Module, Distribution
-
-Although it may be considered internal, the class hierarchy does matter
-for both users and programmer. CPAN.pm deals with above mentioned four
-classes, and all those classes share a set of methods. A classical
-single polymorphism is in effect. A metaclass object registers all
-objects of all kinds and indexes them with a string. The strings
-referencing objects have a separated namespace (well, not completely
-separated):
-
- Namespace Class
-
- words containing a "/" (slash) Distribution
- words starting with Bundle:: Bundle
- everything else Module or Author
-
-Modules know their associated Distribution objects. They always refer
-to the most recent official release. Developers may mark their releases
-as unstable development versions (by inserting an underbar into the
-module version number which will also be reflected in the distribution
-name when you run 'make dist'), so the really hottest and newest
-distribution is not always the default. If a module Foo circulates
-on CPAN in both version 1.23 and 1.23_90, CPAN.pm offers a convenient
-way to install version 1.23 by saying
-
- install Foo
-
-This would install the complete distribution file (say
-BAR/Foo-1.23.tar.gz) with all accompanying material. But if you would
-like to install version 1.23_90, you need to know where the
-distribution file resides on CPAN relative to the authors/id/
-directory. If the author is BAR, this might be BAR/Foo-1.23_90.tar.gz;
-so you would have to say
-
- install BAR/Foo-1.23_90.tar.gz
-
-The first example will be driven by an object of the class
-CPAN::Module, the second by an object of class CPAN::Distribution.
-
-=head2 Integrating local directories
-
-Note: this feature is still in alpha state and may change in future
-versions of CPAN.pm
-
-Distribution objects are normally distributions from the CPAN, but
-there is a slightly degenerate case for Distribution objects, too, of
-projects held on the local disk. These distribution objects have the
-same name as the local directory and end with a dot. A dot by itself
-is also allowed for the current directory at the time CPAN.pm was
-used. All actions such as C<make>, C<test>, and C<install> are applied
-directly to that directory. This gives the command C<cpan .> an
-interesting touch: while the normal mantra of installing a CPAN module
-without CPAN.pm is one of
-
- perl Makefile.PL perl Build.PL
- ( go and get prerequisites )
- make ./Build
- make test ./Build test
- make install ./Build install
-
-the command C<cpan .> does all of this at once. It figures out which
-of the two mantras is appropriate, fetches and installs all
-prerequisites, cares for them recursively and finally finishes the
-installation of the module in the current directory, be it a CPAN
-module or not.
-
-The typical usage case is for private modules or working copies of
-projects from remote repositories on the local disk.
-
-=head1 CONFIGURATION
-
-When the CPAN module is used for the first time, a configuration
-dialog tries to determine a couple of site specific options. The
-result of the dialog is stored in a hash reference C< $CPAN::Config >
-in a file CPAN/Config.pm.
-
-The default values defined in the CPAN/Config.pm file can be
-overridden in a user specific file: CPAN/MyConfig.pm. Such a file is
-best placed in $HOME/.cpan/CPAN/MyConfig.pm, because $HOME/.cpan is
-added to the search path of the CPAN module before the use() or
-require() statements. The mkmyconfig command writes this file for you.
-
-The C<o conf> command has various bells and whistles:
-
-=over
-
-=item completion support
-
-If you have a ReadLine module installed, you can hit TAB at any point
-of the commandline and C<o conf> will offer you completion for the
-built-in subcommands and/or config variable names.
-
-=item displaying some help: o conf help
-
-Displays a short help
-
-=item displaying current values: o conf [KEY]
-
-Displays the current value(s) for this config variable. Without KEY
-displays all subcommands and config variables.
-
-Example:
-
- o conf shell
-
-If KEY starts and ends with a slash the string in between is
-interpreted as a regular expression and only keys matching this regex
-are displayed
-
-Example:
-
- o conf /color/
-
-=item changing of scalar values: o conf KEY VALUE
-
-Sets the config variable KEY to VALUE. The empty string can be
-specified as usual in shells, with C<''> or C<"">
-
-Example:
-
- o conf wget /usr/bin/wget
-
-=item changing of list values: o conf KEY SHIFT|UNSHIFT|PUSH|POP|SPLICE|LIST
-
-If a config variable name ends with C<list>, it is a list. C<o conf
-KEY shift> removes the first element of the list, C<o conf KEY pop>
-removes the last element of the list. C<o conf KEYS unshift LIST>
-prepends a list of values to the list, C<o conf KEYS push LIST>
-appends a list of valued to the list.
-
-Likewise, C<o conf KEY splice LIST> passes the LIST to the according
-splice command.
-
-Finally, any other list of arguments is taken as a new list value for
-the KEY variable discarding the previous value.
-
-Examples:
-
- o conf urllist unshift http://cpan.dev.local/CPAN
- o conf urllist splice 3 1
- o conf urllist http://cpan1.local http://cpan2.local ftp://ftp.perl.org
-
-=item reverting to saved: o conf defaults
-
-Reverts all config variables to the state in the saved config file.
-
-=item saving the config: o conf commit
-
-Saves all config variables to the current config file (CPAN/Config.pm
-or CPAN/MyConfig.pm that was loaded at start).
-
-=back
-
-The configuration dialog can be started any time later again by
-issuing the command C< o conf init > in the CPAN shell. A subset of
-the configuration dialog can be run by issuing C<o conf init WORD>
-where WORD is any valid config variable or a regular expression.
-
-=head2 Config Variables
-
-Currently the following keys in the hash reference $CPAN::Config are
-defined:
-
- applypatch path to external prg
- auto_commit commit all changes to config variables to disk
- build_cache size of cache for directories to build modules
- build_dir locally accessible directory to build modules
- build_dir_reuse boolean if distros in build_dir are persistent
- build_requires_install_policy
- to install or not to install when a module is
- only needed for building. yes|no|ask/yes|ask/no
- bzip2 path to external prg
- cache_metadata use serializer to cache metadata
- commands_quote prefered character to use for quoting external
- commands when running them. Defaults to double
- quote on Windows, single tick everywhere else;
- can be set to space to disable quoting
- check_sigs if signatures should be verified
- colorize_debug Term::ANSIColor attributes for debugging output
- colorize_output boolean if Term::ANSIColor should colorize output
- colorize_print Term::ANSIColor attributes for normal output
- colorize_warn Term::ANSIColor attributes for warnings
- commandnumber_in_prompt
- boolean if you want to see current command number
- cpan_home local directory reserved for this package
- curl path to external prg
- dontload_hash DEPRECATED
- dontload_list arrayref: modules in the list will not be
- loaded by the CPAN::has_inst() routine
- ftp path to external prg
- ftp_passive if set, the envariable FTP_PASSIVE is set for downloads
- ftp_proxy proxy host for ftp requests
- getcwd see below
- gpg path to external prg
- gzip location of external program gzip
- histfile file to maintain history between sessions
- histsize maximum number of lines to keep in histfile
- http_proxy proxy host for http requests
- inactivity_timeout breaks interactive Makefile.PLs or Build.PLs
- after this many seconds inactivity. Set to 0 to
- never break.
- index_expire after this many days refetch index files
- inhibit_startup_message
- if true, does not print the startup message
- keep_source_where directory in which to keep the source (if we do)
- load_module_verbosity
- report loading of optional modules used by CPAN.pm
- lynx path to external prg
- make location of external make program
- make_arg arguments that should always be passed to 'make'
- make_install_make_command
- the make command for running 'make install', for
- example 'sudo make'
- make_install_arg same as make_arg for 'make install'
- makepl_arg arguments passed to 'perl Makefile.PL'
- mbuild_arg arguments passed to './Build'
- mbuild_install_arg arguments passed to './Build install'
- mbuild_install_build_command
- command to use instead of './Build' when we are
- in the install stage, for example 'sudo ./Build'
- mbuildpl_arg arguments passed to 'perl Build.PL'
- ncftp path to external prg
- ncftpget path to external prg
- no_proxy don't proxy to these hosts/domains (comma separated list)
- pager location of external program more (or any pager)
- password your password if you CPAN server wants one
- patch path to external prg
- prefer_installer legal values are MB and EUMM: if a module comes
- with both a Makefile.PL and a Build.PL, use the
- former (EUMM) or the latter (MB); if the module
- comes with only one of the two, that one will be
- used in any case
- prerequisites_policy
- what to do if you are missing module prerequisites
- ('follow' automatically, 'ask' me, or 'ignore')
- prefs_dir local directory to store per-distro build options
- proxy_user username for accessing an authenticating proxy
- proxy_pass password for accessing an authenticating proxy
- randomize_urllist add some randomness to the sequence of the urllist
- scan_cache controls scanning of cache ('atstart' or 'never')
- shell your favorite shell
- show_unparsable_versions
- boolean if r command tells which modules are versionless
- show_upload_date boolean if commands should try to determine upload date
- show_zero_versions boolean if r command tells for which modules $version==0
- tar location of external program tar
- tar_verbosity verbosity level for the tar command
- term_is_latin deprecated: if true Unicode is translated to ISO-8859-1
- (and nonsense for characters outside latin range)
- term_ornaments boolean to turn ReadLine ornamenting on/off
- test_report email test reports (if CPAN::Reporter is installed)
- unzip location of external program unzip
- urllist arrayref to nearby CPAN sites (or equivalent locations)
- use_sqlite use CPAN::SQLite for metadata storage (fast and lean)
- username your username if you CPAN server wants one
- wait_list arrayref to a wait server to try (See CPAN::WAIT)
- wget path to external prg
- yaml_load_code enable YAML code deserialisation
- yaml_module which module to use to read/write YAML files
-
-You can set and query each of these options interactively in the cpan
-shell with the C<o conf> or the C<o conf init> command as specified below.
-
-=over 2
-
-=item C<o conf E<lt>scalar optionE<gt>>
-
-prints the current value of the I<scalar option>
-
-=item C<o conf E<lt>scalar optionE<gt> E<lt>valueE<gt>>
-
-Sets the value of the I<scalar option> to I<value>
-
-=item C<o conf E<lt>list optionE<gt>>
-
-prints the current value of the I<list option> in MakeMaker's
-neatvalue format.
-
-=item C<o conf E<lt>list optionE<gt> [shift|pop]>
-
-shifts or pops the array in the I<list option> variable
-
-=item C<o conf E<lt>list optionE<gt> [unshift|push|splice] E<lt>listE<gt>>
-
-works like the corresponding perl commands.
-
-=item interactive editing: o conf init [MATCH|LIST]
-
-Runs an interactive configuration dialog for matching variables.
-Without argument runs the dialog over all supported config variables.
-To specify a MATCH the argument must be enclosed by slashes.
-
-Examples:
-
- o conf init ftp_passive ftp_proxy
- o conf init /color/
-
-Note: this method of setting config variables often provides more
-explanation about the functioning of a variable than the manpage.
-
-=back
-
-=head2 CPAN::anycwd($path): Note on config variable getcwd
-
-CPAN.pm changes the current working directory often and needs to
-determine its own current working directory. Per default it uses
-Cwd::cwd but if this doesn't work on your system for some reason,
-alternatives can be configured according to the following table:
-
-=over 4
-
-=item cwd
-
-Calls Cwd::cwd
-
-=item getcwd
-
-Calls Cwd::getcwd
-
-=item fastcwd
-
-Calls Cwd::fastcwd
-
-=item backtickcwd
-
-Calls the external command cwd.
-
-=back
-
-=head2 Note on the format of the urllist parameter
-
-urllist parameters are URLs according to RFC 1738. We do a little
-guessing if your URL is not compliant, but if you have problems with
-C<file> URLs, please try the correct format. Either:
-
- file://localhost/whatever/ftp/pub/CPAN/
-
-or
-
- file:///home/ftp/pub/CPAN/
-
-=head2 The urllist parameter has CD-ROM support
-
-The C<urllist> parameter of the configuration table contains a list of
-URLs that are to be used for downloading. If the list contains any
-C<file> URLs, CPAN always tries to get files from there first. This
-feature is disabled for index files. So the recommendation for the
-owner of a CD-ROM with CPAN contents is: include your local, possibly
-outdated CD-ROM as a C<file> URL at the end of urllist, e.g.
-
- o conf urllist push file://localhost/CDROM/CPAN
-
-CPAN.pm will then fetch the index files from one of the CPAN sites
-that come at the beginning of urllist. It will later check for each
-module if there is a local copy of the most recent version.
-
-Another peculiarity of urllist is that the site that we could
-successfully fetch the last file from automatically gets a preference
-token and is tried as the first site for the next request. So if you
-add a new site at runtime it may happen that the previously preferred
-site will be tried another time. This means that if you want to disallow
-a site for the next transfer, it must be explicitly removed from
-urllist.
-
-=head2 Maintaining the urllist parameter
-
-If you have YAML.pm (or some other YAML module configured in
-C<yaml_module>) installed, CPAN.pm collects a few statistical data
-about recent downloads. You can view the statistics with the C<hosts>
-command or inspect them directly by looking into the C<FTPstats.yml>
-file in your C<cpan_home> directory.
-
-To get some interesting statistics it is recommended to set the
-C<randomize_urllist> parameter that introduces some amount of
-randomness into the URL selection.
-
-=head2 The C<requires> and C<build_requires> dependency declarations
-
-Since CPAN.pm version 1.88_51 modules declared as C<build_requires> by
-a distribution are treated differently depending on the config
-variable C<build_requires_install_policy>. By setting
-C<build_requires_install_policy> to C<no> such a module is not being
-installed. It is only built and tested and then kept in the list of
-tested but uninstalled modules. As such it is available during the
-build of the dependent module by integrating the path to the
-C<blib/arch> and C<blib/lib> directories in the environment variable
-PERL5LIB. If C<build_requires_install_policy> is set ti C<yes>, then
-both modules declared as C<requires> and those declared as
-C<build_requires> are treated alike. By setting to C<ask/yes> or
-C<ask/no>, CPAN.pm asks the user and sets the default accordingly.
-
-=head2 Configuration for individual distributions (I<Distroprefs>)
-
-(B<Note:> This feature has been introduced in CPAN.pm 1.8854 and is
-still considered beta quality)
-
-Distributions on the CPAN usually behave according to what we call the
-CPAN mantra. Or since the event of Module::Build we should talk about
-two mantras:
-
- perl Makefile.PL perl Build.PL
- make ./Build
- make test ./Build test
- make install ./Build install
-
-But some modules cannot be built with this mantra. They try to get
-some extra data from the user via the environment, extra arguments or
-interactively thus disturbing the installation of large bundles like
-Phalanx100 or modules with many dependencies like Plagger.
-
-The distroprefs system of C<CPAN.pm> addresses this problem by
-allowing the user to specify extra informations and recipes in YAML
-files to either
-
-=over
-
-=item
-
-pass additional arguments to one of the four commands,
-
-=item
-
-set environment variables
-
-=item
-
-instantiate an Expect object that reads from the console, waits for
-some regular expressions and enters some answers
-
-=item
-
-temporarily override assorted C<CPAN.pm> configuration variables
-
-=item
-
-specify dependencies that the original maintainer forgot to specify
-
-=item
-
-disable the installation of an object altogether
-
-=back
-
-See the YAML and Data::Dumper files that come with the C<CPAN.pm>
-distribution in the C<distroprefs/> directory for examples.
-
-=head2 Filenames
-
-The YAML files themselves must have the C<.yml> extension, all other
-files are ignored (for two exceptions see I<Fallback Data::Dumper and
-Storable> below). The containing directory can be specified in
-C<CPAN.pm> in the C<prefs_dir> config variable. Try C<o conf init
-prefs_dir> in the CPAN shell to set and activate the distroprefs
-system.
-
-Every YAML file may contain arbitrary documents according to the YAML
-specification and every single document is treated as an entity that
-can specify the treatment of a single distribution.
-
-The names of the files can be picked freely, C<CPAN.pm> always reads
-all files (in alphabetical order) and takes the key C<match> (see
-below in I<Language Specs>) as a hashref containing match criteria
-that determine if the current distribution matches the YAML document
-or not.
-
-=head2 Fallback Data::Dumper and Storable
-
-If neither your configured C<yaml_module> nor YAML.pm is installed
-CPAN.pm falls back to using Data::Dumper and Storable and looks for
-files with the extensions C<.dd> or C<.st> in the C<prefs_dir>
-directory. These files are expected to contain one or more hashrefs.
-For Data::Dumper generated files, this is expected to be done with by
-defining C<$VAR1>, C<$VAR2>, etc. The YAML shell would produce these
-with the command
-
- ysh < somefile.yml > somefile.dd
-
-For Storable files the rule is that they must be constructed such that
-C<Storable::retrieve(file)> returns an array reference and the array
-elements represent one distropref object each. The conversion from
-YAML would look like so:
-
- perl -MYAML=LoadFile -MStorable=nstore -e '
- @y=LoadFile(shift);
- nstore(\@y, shift)' somefile.yml somefile.st
-
-In bootstrapping situations it is usually sufficient to translate only
-a few YAML files to Data::Dumper for the crucial modules like
-C<YAML::Syck>, C<YAML.pm> and C<Expect.pm>. If you prefer Storable
-over Data::Dumper, remember to pull out a Storable version that writes
-an older format than all the other Storable versions that will need to
-read them.
-
-=head2 Blueprint
-
-The following example contains all supported keywords and structures
-with the exception of C<eexpect> which can be used instead of
-C<expect>.
-
- ---
- comment: "Demo"
- match:
- module: "Dancing::Queen"
- distribution: "^CHACHACHA/Dancing-"
- perl: "/usr/local/cariba-perl/bin/perl"
- perlconfig:
- archname: "freebsd"
- disabled: 1
- cpanconfig:
- make: gmake
- pl:
- args:
- - "--somearg=specialcase"
-
- env: {}
-
- expect:
- - "Which is your favorite fruit"
- - "apple\n"
-
- make:
- args:
- - all
- - extra-all
-
- env: {}
-
- expect: []
-
- commendline: "echo SKIPPING make"
-
- test:
- args: []
-
- env: {}
-
- expect: []
-
- install:
- args: []
-
- env:
- WANT_TO_INSTALL: YES
-
- expect:
- - "Do you really want to install"
- - "y\n"
-
- patches:
- - "ABCDE/Fedcba-3.14-ABCDE-01.patch"
-
- depends:
- configure_requires:
- LWP: 5.8
- build_requires:
- Test::Exception: 0.25
- requires:
- Spiffy: 0.30
-
-
-=head2 Language Specs
-
-Every YAML document represents a single hash reference. The valid keys
-in this hash are as follows:
-
-=over
-
-=item comment [scalar]
-
-A comment
-
-=item cpanconfig [hash]
-
-Temporarily override assorted C<CPAN.pm> configuration variables.
-
-Supported are: C<build_requires_install_policy>, C<check_sigs>,
-C<make>, C<make_install_make_command>, C<prefer_installer>,
-C<test_report>. Please report as a bug when you need another one
-supported.
-
-=item depends [hash] *** EXPERIMENTAL FEATURE ***
-
-All three types, namely C<configure_requires>, C<build_requires>, and
-C<requires> are supported in the way specified in the META.yml
-specification. The current implementation I<merges> the specified
-dependencies with those declared by the package maintainer. In a
-future implementation this may be changed to override the original
-declaration.
-
-=item disabled [boolean]
-
-Specifies that this distribution shall not be processed at all.
-
-=item goto [string]
-
-The canonical name of a delegate distribution that shall be installed
-instead. Useful when a new version, although it tests OK itself,
-breaks something else or a developer release or a fork is already
-uploaded that is better than the last released version.
-
-=item install [hash]
-
-Processing instructions for the C<make install> or C<./Build install>
-phase of the CPAN mantra. See below under I<Processiong Instructions>.
-
-=item make [hash]
-
-Processing instructions for the C<make> or C<./Build> phase of the
-CPAN mantra. See below under I<Processiong Instructions>.
-
-=item match [hash]
-
-A hashref with one or more of the keys C<distribution>, C<modules>,
-C<perl>, and C<perlconfig> that specify if a document is targeted at a
-specific CPAN distribution or installation.
-
-The corresponding values are interpreted as regular expressions. The
-C<distribution> related one will be matched against the canonical
-distribution name, e.g. "AUTHOR/Foo-Bar-3.14.tar.gz".
-
-The C<module> related one will be matched against I<all> modules
-contained in the distribution until one module matches.
-
-The C<perl> related one will be matched against C<$^X> (but with the
-absolute path).
-
-The value associated with C<perlconfig> is itself a hashref that is
-matched against corresponding values in the C<%Config::Config> hash
-living in the C< Config.pm > module.
-
-If more than one restriction of C<module>, C<distribution>, and
-C<perl> is specified, the results of the separately computed match
-values must all match. If this is the case then the hashref
-represented by the YAML document is returned as the preference
-structure for the current distribution.
-
-=item patches [array]
-
-An array of patches on CPAN or on the local disk to be applied in
-order via the external patch program. If the value for the C<-p>
-parameter is C<0> or C<1> is determined by reading the patch
-beforehand.
-
-Note: if the C<applypatch> program is installed and C<CPAN::Config>
-knows about it B<and> a patch is written by the C<makepatch> program,
-then C<CPAN.pm> lets C<applypatch> apply the patch. Both C<makepatch>
-and C<applypatch> are available from CPAN in the C<JV/makepatch-*>
-distribution.
-
-=item pl [hash]
-
-Processing instructions for the C<perl Makefile.PL> or C<perl
-Build.PL> phase of the CPAN mantra. See below under I<Processiong
-Instructions>.
-
-=item test [hash]
-
-Processing instructions for the C<make test> or C<./Build test> phase
-of the CPAN mantra. See below under I<Processiong Instructions>.
-
-=back
-
-=head2 Processing Instructions
-
-=over
-
-=item args [array]
-
-Arguments to be added to the command line
-
-=item commandline
-
-A full commandline that will be executed as it stands by a system
-call. During the execution the environment variable PERL will is set
-to $^X (but with an absolute path). If C<commandline> is specified,
-the content of C<args> is not used.
-
-=item eexpect [hash]
-
-Extended C<expect>. This is a hash reference with four allowed keys,
-C<mode>, C<timeout>, C<reuse>, and C<talk>.
-
-C<mode> may have the values C<deterministic> for the case where all
-questions come in the order written down and C<anyorder> for the case
-where the questions may come in any order. The default mode is
-C<deterministic>.
-
-C<timeout> denotes a timeout in seconds. Floating point timeouts are
-OK. In the case of a C<mode=deterministic> the timeout denotes the
-timeout per question, in the case of C<mode=anyorder> it denotes the
-timeout per byte received from the stream or questions.
-
-C<talk> is a reference to an array that contains alternating questions
-and answers. Questions are regular expressions and answers are literal
-strings. The Expect module will then watch the stream coming from the
-execution of the external program (C<perl Makefile.PL>, C<perl
-Build.PL>, C<make>, etc.).
-
-In the case of C<mode=deterministic> the CPAN.pm will inject the
-according answer as soon as the stream matches the regular expression.
-
-In the case of C<mode=anyorder> CPAN.pm will answer a question as soon
-as the timeout is reached for the next byte in the input stream. In
-this mode you can use the C<reuse> parameter to decide what shall
-happen with a question-answer pair after it has been used. In the
-default case (reuse=0) it is removed from the array, so it cannot be
-used again accidentally. In this case, if you want to answer the
-question C<Do you really want to do that> several times, then it must
-be included in the array at least as often as you want this answer to
-be given. Setting the parameter C<reuse> to 1 makes this repetition
-unnecessary.
-
-=item env [hash]
-
-Environment variables to be set during the command
-
-=item expect [array]
-
-C<< expect: <array> >> is a short notation for
-
- eexpect:
- mode: deterministic
- timeout: 15
- talk: <array>
-
-=back
-
-=head2 Schema verification with C<Kwalify>
-
-If you have the C<Kwalify> module installed (which is part of the
-Bundle::CPANxxl), then all your distroprefs files are checked for
-syntactical correctness.
-
-=head2 Example Distroprefs Files
-
-C<CPAN.pm> comes with a collection of example YAML files. Note that these
-are really just examples and should not be used without care because
-they cannot fit everybody's purpose. After all the authors of the
-packages that ask questions had a need to ask, so you should watch
-their questions and adjust the examples to your environment and your
-needs. You have beend warned:-)
-
-=head1 PROGRAMMER'S INTERFACE
-
-If you do not enter the shell, the available shell commands are both
-available as methods (C<CPAN::Shell-E<gt>install(...)>) and as
-functions in the calling package (C<install(...)>). Before calling low-level
-commands it makes sense to initialize components of CPAN you need, e.g.:
-
- CPAN::HandleConfig->load;
- CPAN::Shell::setup_output;
- CPAN::Index->reload;
-
-High-level commands do such initializations automatically.
-
-There's currently only one class that has a stable interface -
-CPAN::Shell. All commands that are available in the CPAN shell are
-methods of the class CPAN::Shell. Each of the commands that produce
-listings of modules (C<r>, C<autobundle>, C<u>) also return a list of
-the IDs of all modules within the list.
-
-=over 2
-
-=item expand($type,@things)
-
-The IDs of all objects available within a program are strings that can
-be expanded to the corresponding real objects with the
-C<CPAN::Shell-E<gt>expand("Module",@things)> method. Expand returns a
-list of CPAN::Module objects according to the C<@things> arguments
-given. In scalar context it only returns the first element of the
-list.
-
-=item expandany(@things)
-
-Like expand, but returns objects of the appropriate type, i.e.
-CPAN::Bundle objects for bundles, CPAN::Module objects for modules and
-CPAN::Distribution objects for distributions. Note: it does not expand
-to CPAN::Author objects.
-
-=item Programming Examples
-
-This enables the programmer to do operations that combine
-functionalities that are available in the shell.
-
- # install everything that is outdated on my disk:
- perl -MCPAN -e 'CPAN::Shell->install(CPAN::Shell->r)'
-
- # install my favorite programs if necessary:
- for $mod (qw(Net::FTP Digest::SHA Data::Dumper)) {
- CPAN::Shell->install($mod);
- }
-
- # list all modules on my disk that have no VERSION number
- for $mod (CPAN::Shell->expand("Module","/./")) {
- next unless $mod->inst_file;
- # MakeMaker convention for undefined $VERSION:
- next unless $mod->inst_version eq "undef";
- print "No VERSION in ", $mod->id, "\n";
- }
-
- # find out which distribution on CPAN contains a module:
- print CPAN::Shell->expand("Module","Apache::Constants")->cpan_file
-
-Or if you want to write a cronjob to watch The CPAN, you could list
-all modules that need updating. First a quick and dirty way:
-
- perl -e 'use CPAN; CPAN::Shell->r;'
-
-If you don't want to get any output in the case that all modules are
-up to date, you can parse the output of above command for the regular
-expression //modules are up to date// and decide to mail the output
-only if it doesn't match. Ick?
-
-If you prefer to do it more in a programmer style in one single
-process, maybe something like this suits you better:
-
- # list all modules on my disk that have newer versions on CPAN
- for $mod (CPAN::Shell->expand("Module","/./")) {
- next unless $mod->inst_file;
- next if $mod->uptodate;
- printf "Module %s is installed as %s, could be updated to %s from CPAN\n",
- $mod->id, $mod->inst_version, $mod->cpan_version;
- }
-
-If that gives you too much output every day, you maybe only want to
-watch for three modules. You can write
-
- for $mod (CPAN::Shell->expand("Module","/Apache|LWP|CGI/")) {
-
-as the first line instead. Or you can combine some of the above
-tricks:
-
- # watch only for a new mod_perl module
- $mod = CPAN::Shell->expand("Module","mod_perl");
- exit if $mod->uptodate;
- # new mod_perl arrived, let me know all update recommendations
- CPAN::Shell->r;
-
-=back
-
-=head2 Methods in the other Classes
-
-=over 4
-
-=item CPAN::Author::as_glimpse()
-
-Returns a one-line description of the author
-
-=item CPAN::Author::as_string()
-
-Returns a multi-line description of the author
-
-=item CPAN::Author::email()
-
-Returns the author's email address
-
-=item CPAN::Author::fullname()
-
-Returns the author's name
-
-=item CPAN::Author::name()
-
-An alias for fullname
-
-=item CPAN::Bundle::as_glimpse()
-
-Returns a one-line description of the bundle
-
-=item CPAN::Bundle::as_string()
-
-Returns a multi-line description of the bundle
-
-=item CPAN::Bundle::clean()
-
-Recursively runs the C<clean> method on all items contained in the bundle.
-
-=item CPAN::Bundle::contains()
-
-Returns a list of objects' IDs contained in a bundle. The associated
-objects may be bundles, modules or distributions.
-
-=item CPAN::Bundle::force($method,@args)
-
-Forces CPAN to perform a task that it normally would have refused to
-do. Force takes as arguments a method name to be called and any number
-of additional arguments that should be passed to the called method.
-The internals of the object get the needed changes so that CPAN.pm
-does not refuse to take the action. The C<force> is passed recursively
-to all contained objects. See also the section above on the C<force>
-and the C<fforce> pragma.
-
-=item CPAN::Bundle::get()
-
-Recursively runs the C<get> method on all items contained in the bundle
-
-=item CPAN::Bundle::inst_file()
-
-Returns the highest installed version of the bundle in either @INC or
-C<$CPAN::Config->{cpan_home}>. Note that this is different from
-CPAN::Module::inst_file.
-
-=item CPAN::Bundle::inst_version()
-
-Like CPAN::Bundle::inst_file, but returns the $VERSION
-
-=item CPAN::Bundle::uptodate()
-
-Returns 1 if the bundle itself and all its members are uptodate.
-
-=item CPAN::Bundle::install()
-
-Recursively runs the C<install> method on all items contained in the bundle
-
-=item CPAN::Bundle::make()
-
-Recursively runs the C<make> method on all items contained in the bundle
-
-=item CPAN::Bundle::readme()
-
-Recursively runs the C<readme> method on all items contained in the bundle
-
-=item CPAN::Bundle::test()
-
-Recursively runs the C<test> method on all items contained in the bundle
-
-=item CPAN::Distribution::as_glimpse()
-
-Returns a one-line description of the distribution
-
-=item CPAN::Distribution::as_string()
-
-Returns a multi-line description of the distribution
-
-=item CPAN::Distribution::author
-
-Returns the CPAN::Author object of the maintainer who uploaded this
-distribution
-
-=item CPAN::Distribution::pretty_id()
-
-Returns a string of the form "AUTHORID/TARBALL", where AUTHORID is the
-author's PAUSE ID and TARBALL is the distribution filename.
-
-=item CPAN::Distribution::base_id()
-
-Returns the distribution filename without any archive suffix. E.g
-"Foo-Bar-0.01"
-
-=item CPAN::Distribution::clean()
-
-Changes to the directory where the distribution has been unpacked and
-runs C<make clean> there.
-
-=item CPAN::Distribution::containsmods()
-
-Returns a list of IDs of modules contained in a distribution file.
-Only works for distributions listed in the 02packages.details.txt.gz
-file. This typically means that only the most recent version of a
-distribution is covered.
-
-=item CPAN::Distribution::cvs_import()
-
-Changes to the directory where the distribution has been unpacked and
-runs something like
-
- cvs -d $cvs_root import -m $cvs_log $cvs_dir $userid v$version
-
-there.
-
-=item CPAN::Distribution::dir()
-
-Returns the directory into which this distribution has been unpacked.
-
-=item CPAN::Distribution::force($method,@args)
-
-Forces CPAN to perform a task that it normally would have refused to
-do. Force takes as arguments a method name to be called and any number
-of additional arguments that should be passed to the called method.
-The internals of the object get the needed changes so that CPAN.pm
-does not refuse to take the action. See also the section above on the
-C<force> and the C<fforce> pragma.
-
-=item CPAN::Distribution::get()
-
-Downloads the distribution from CPAN and unpacks it. Does nothing if
-the distribution has already been downloaded and unpacked within the
-current session.
-
-=item CPAN::Distribution::install()
-
-Changes to the directory where the distribution has been unpacked and
-runs the external command C<make install> there. If C<make> has not
-yet been run, it will be run first. A C<make test> will be issued in
-any case and if this fails, the install will be canceled. The
-cancellation can be avoided by letting C<force> run the C<install> for
-you.
-
-This install method has only the power to install the distribution if
-there are no dependencies in the way. To install an object and all of
-its dependencies, use CPAN::Shell->install.
-
-Note that install() gives no meaningful return value. See uptodate().
-
-=item CPAN::Distribution::install_tested()
-
-Install all the distributions that have been tested sucessfully but
-not yet installed. See also C<is_tested>.
-
-=item CPAN::Distribution::isa_perl()
-
-Returns 1 if this distribution file seems to be a perl distribution.
-Normally this is derived from the file name only, but the index from
-CPAN can contain a hint to achieve a return value of true for other
-filenames too.
-
-=item CPAN::Distribution::is_tested()
-
-List all the distributions that have been tested sucessfully but not
-yet installed. See also C<install_tested>.
-
-=item CPAN::Distribution::look()
-
-Changes to the directory where the distribution has been unpacked and
-opens a subshell there. Exiting the subshell returns.
-
-=item CPAN::Distribution::make()
-
-First runs the C<get> method to make sure the distribution is
-downloaded and unpacked. Changes to the directory where the
-distribution has been unpacked and runs the external commands C<perl
-Makefile.PL> or C<perl Build.PL> and C<make> there.
-
-=item CPAN::Distribution::perldoc()
-
-Downloads the pod documentation of the file associated with a
-distribution (in html format) and runs it through the external
-command lynx specified in C<$CPAN::Config->{lynx}>. If lynx
-isn't available, it converts it to plain text with external
-command html2text and runs it through the pager specified
-in C<$CPAN::Config->{pager}>
-
-=item CPAN::Distribution::prefs()
-
-Returns the hash reference from the first matching YAML file that the
-user has deposited in the C<prefs_dir/> directory. The first
-succeeding match wins. The files in the C<prefs_dir/> are processed
-alphabetically and the canonical distroname (e.g.
-AUTHOR/Foo-Bar-3.14.tar.gz) is matched against the regular expressions
-stored in the $root->{match}{distribution} attribute value.
-Additionally all module names contained in a distribution are matched
-agains the regular expressions in the $root->{match}{module} attribute
-value. The two match values are ANDed together. Each of the two
-attributes are optional.
-
-=item CPAN::Distribution::prereq_pm()
-
-Returns the hash reference that has been announced by a distribution
-as the the C<requires> and C<build_requires> elements. These can be
-declared either by the C<META.yml> (if authoritative) or can be
-deposited after the run of C<Build.PL> in the file C<./_build/prereqs>
-or after the run of C<Makfile.PL> written as the C<PREREQ_PM> hash in
-a comment in the produced C<Makefile>. I<Note>: this method only works
-after an attempt has been made to C<make> the distribution. Returns
-undef otherwise.
-
-=item CPAN::Distribution::readme()
-
-Downloads the README file associated with a distribution and runs it
-through the pager specified in C<$CPAN::Config->{pager}>.
-
-=item CPAN::Distribution::reports()
-
-Downloads report data for this distribution from cpantesters.perl.org
-and displays a subset of them.
-
-=item CPAN::Distribution::read_yaml()
-
-Returns the content of the META.yml of this distro as a hashref. Note:
-works only after an attempt has been made to C<make> the distribution.
-Returns undef otherwise. Also returns undef if the content of META.yml
-is not authoritative. (The rules about what exactly makes the content
-authoritative are still in flux.)
-
-=item CPAN::Distribution::test()
-
-Changes to the directory where the distribution has been unpacked and
-runs C<make test> there.
-
-=item CPAN::Distribution::uptodate()
-
-Returns 1 if all the modules contained in the distribution are
-uptodate. Relies on containsmods.
-
-=item CPAN::Index::force_reload()
-
-Forces a reload of all indices.
-
-=item CPAN::Index::reload()
-
-Reloads all indices if they have not been read for more than
-C<$CPAN::Config->{index_expire}> days.
-
-=item CPAN::InfoObj::dump()
-
-CPAN::Author, CPAN::Bundle, CPAN::Module, and CPAN::Distribution
-inherit this method. It prints the data structure associated with an
-object. Useful for debugging. Note: the data structure is considered
-internal and thus subject to change without notice.
-
-=item CPAN::Module::as_glimpse()
-
-Returns a one-line description of the module in four columns: The
-first column contains the word C<Module>, the second column consists
-of one character: an equals sign if this module is already installed
-and uptodate, a less-than sign if this module is installed but can be
-upgraded, and a space if the module is not installed. The third column
-is the name of the module and the fourth column gives maintainer or
-distribution information.
-
-=item CPAN::Module::as_string()
-
-Returns a multi-line description of the module
-
-=item CPAN::Module::clean()
-
-Runs a clean on the distribution associated with this module.
-
-=item CPAN::Module::cpan_file()
-
-Returns the filename on CPAN that is associated with the module.
-
-=item CPAN::Module::cpan_version()
-
-Returns the latest version of this module available on CPAN.
-
-=item CPAN::Module::cvs_import()
-
-Runs a cvs_import on the distribution associated with this module.
-
-=item CPAN::Module::description()
-
-Returns a 44 character description of this module. Only available for
-modules listed in The Module List (CPAN/modules/00modlist.long.html
-or 00modlist.long.txt.gz)
-
-=item CPAN::Module::distribution()
-
-Returns the CPAN::Distribution object that contains the current
-version of this module.
-
-=item CPAN::Module::dslip_status()
-
-Returns a hash reference. The keys of the hash are the letters C<D>,
-C<S>, C<L>, C<I>, and <P>, for development status, support level,
-language, interface and public licence respectively. The data for the
-DSLIP status are collected by pause.perl.org when authors register
-their namespaces. The values of the 5 hash elements are one-character
-words whose meaning is described in the table below. There are also 5
-hash elements C<DV>, C<SV>, C<LV>, C<IV>, and <PV> that carry a more
-verbose value of the 5 status variables.
-
-Where the 'DSLIP' characters have the following meanings:
-
- D - Development Stage (Note: *NO IMPLIED TIMESCALES*):
- i - Idea, listed to gain consensus or as a placeholder
- c - under construction but pre-alpha (not yet released)
- a/b - Alpha/Beta testing
- R - Released
- M - Mature (no rigorous definition)
- S - Standard, supplied with Perl 5
-
- S - Support Level:
- m - Mailing-list
- d - Developer
- u - Usenet newsgroup comp.lang.perl.modules
- n - None known, try comp.lang.perl.modules
- a - abandoned; volunteers welcome to take over maintainance
-
- L - Language Used:
- p - Perl-only, no compiler needed, should be platform independent
- c - C and perl, a C compiler will be needed
- h - Hybrid, written in perl with optional C code, no compiler needed
- + - C++ and perl, a C++ compiler will be needed
- o - perl and another language other than C or C++
-
- I - Interface Style
- f - plain Functions, no references used
- h - hybrid, object and function interfaces available
- n - no interface at all (huh?)
- r - some use of unblessed References or ties
- O - Object oriented using blessed references and/or inheritance
-
- P - Public License
- p - Standard-Perl: user may choose between GPL and Artistic
- g - GPL: GNU General Public License
- l - LGPL: "GNU Lesser General Public License" (previously known as
- "GNU Library General Public License")
- b - BSD: The BSD License
- a - Artistic license alone
- 2 - Artistic license 2.0 or later
- o - open source: appoved by www.opensource.org
- d - allows distribution without restrictions
- r - restricted distribtion
- n - no license at all
-
-=item CPAN::Module::force($method,@args)
-
-Forces CPAN to perform a task that it normally would have refused to
-do. Force takes as arguments a method name to be called and any number
-of additional arguments that should be passed to the called method.
-The internals of the object get the needed changes so that CPAN.pm
-does not refuse to take the action. See also the section above on the
-C<force> and the C<fforce> pragma.
-
-=item CPAN::Module::get()
-
-Runs a get on the distribution associated with this module.
-
-=item CPAN::Module::inst_file()
-
-Returns the filename of the module found in @INC. The first file found
-is reported just like perl itself stops searching @INC when it finds a
-module.
-
-=item CPAN::Module::available_file()
-
-Returns the filename of the module found in PERL5LIB or @INC. The
-first file found is reported. The advantage of this method over
-C<inst_file> is that modules that have been tested but not yet
-installed are included because PERL5LIB keeps track of tested modules.
-
-=item CPAN::Module::inst_version()
-
-Returns the version number of the installed module in readable format.
-
-=item CPAN::Module::available_version()
-
-Returns the version number of the available module in readable format.
-
-=item CPAN::Module::install()
-
-Runs an C<install> on the distribution associated with this module.
-
-=item CPAN::Module::look()
-
-Changes to the directory where the distribution associated with this
-module has been unpacked and opens a subshell there. Exiting the
-subshell returns.
-
-=item CPAN::Module::make()
-
-Runs a C<make> on the distribution associated with this module.
-
-=item CPAN::Module::manpage_headline()
-
-If module is installed, peeks into the module's manpage, reads the
-headline and returns it. Moreover, if the module has been downloaded
-within this session, does the equivalent on the downloaded module even
-if it is not installed.
-
-=item CPAN::Module::perldoc()
-
-Runs a C<perldoc> on this module.
-
-=item CPAN::Module::readme()
-
-Runs a C<readme> on the distribution associated with this module.
-
-=item CPAN::Module::reports()
-
-Calls the reports() method on the associated distribution object.
-
-=item CPAN::Module::test()
-
-Runs a C<test> on the distribution associated with this module.
-
-=item CPAN::Module::uptodate()
-
-Returns 1 if the module is installed and up-to-date.
-
-=item CPAN::Module::userid()
-
-Returns the author's ID of the module.
-
-=back
-
-=head2 Cache Manager
-
-Currently the cache manager only keeps track of the build directory
-($CPAN::Config->{build_dir}). It is a simple FIFO mechanism that
-deletes complete directories below C<build_dir> as soon as the size of
-all directories there gets bigger than $CPAN::Config->{build_cache}
-(in MB). The contents of this cache may be used for later
-re-installations that you intend to do manually, but will never be
-trusted by CPAN itself. This is due to the fact that the user might
-use these directories for building modules on different architectures.
-
-There is another directory ($CPAN::Config->{keep_source_where}) where
-the original distribution files are kept. This directory is not
-covered by the cache manager and must be controlled by the user. If
-you choose to have the same directory as build_dir and as
-keep_source_where directory, then your sources will be deleted with
-the same fifo mechanism.
-
-=head2 Bundles
-
-A bundle is just a perl module in the namespace Bundle:: that does not
-define any functions or methods. It usually only contains documentation.
-
-It starts like a perl module with a package declaration and a $VERSION
-variable. After that the pod section looks like any other pod with the
-only difference being that I<one special pod section> exists starting with
-(verbatim):
-
- =head1 CONTENTS
-
-In this pod section each line obeys the format
-
- Module_Name [Version_String] [- optional text]
-
-The only required part is the first field, the name of a module
-(e.g. Foo::Bar, ie. I<not> the name of the distribution file). The rest
-of the line is optional. The comment part is delimited by a dash just
-as in the man page header.
-
-The distribution of a bundle should follow the same convention as
-other distributions.
-
-Bundles are treated specially in the CPAN package. If you say 'install
-Bundle::Tkkit' (assuming such a bundle exists), CPAN will install all
-the modules in the CONTENTS section of the pod. You can install your
-own Bundles locally by placing a conformant Bundle file somewhere into
-your @INC path. The autobundle() command which is available in the
-shell interface does that for you by including all currently installed
-modules in a snapshot bundle file.
-
-=head1 PREREQUISITES
-
-If you have a local mirror of CPAN and can access all files with
-"file:" URLs, then you only need a perl better than perl5.003 to run
-this module. Otherwise Net::FTP is strongly recommended. LWP may be
-required for non-UNIX systems or if your nearest CPAN site is
-associated with a URL that is not C<ftp:>.
-
-If you have neither Net::FTP nor LWP, there is a fallback mechanism
-implemented for an external ftp command or for an external lynx
-command.
-
-=head1 UTILITIES
-
-=head2 Finding packages and VERSION
-
-This module presumes that all packages on CPAN
-
-=over 2
-
-=item *
-
-declare their $VERSION variable in an easy to parse manner. This
-prerequisite can hardly be relaxed because it consumes far too much
-memory to load all packages into the running program just to determine
-the $VERSION variable. Currently all programs that are dealing with
-version use something like this
-
- perl -MExtUtils::MakeMaker -le \
- 'print MM->parse_version(shift)' filename
-
-If you are author of a package and wonder if your $VERSION can be
-parsed, please try the above method.
-
-=item *
-
-come as compressed or gzipped tarfiles or as zip files and contain a
-C<Makefile.PL> or C<Build.PL> (well, we try to handle a bit more, but
-without much enthusiasm).
-
-=back
-
-=head2 Debugging
-
-The debugging of this module is a bit complex, because we have
-interferences of the software producing the indices on CPAN, of the
-mirroring process on CPAN, of packaging, of configuration, of
-synchronicity, and of bugs within CPAN.pm.
-
-For debugging the code of CPAN.pm itself in interactive mode some more
-or less useful debugging aid can be turned on for most packages within
-CPAN.pm with one of
-
-=over 2
-
-=item o debug package...
-
-sets debug mode for packages.
-
-=item o debug -package...
-
-unsets debug mode for packages.
-
-=item o debug all
-
-turns debugging on for all packages.
-
-=item o debug number
-
-=back
-
-which sets the debugging packages directly. Note that C<o debug 0>
-turns debugging off.
-
-What seems quite a successful strategy is the combination of C<reload
-cpan> and the debugging switches. Add a new debug statement while
-running in the shell and then issue a C<reload cpan> and see the new
-debugging messages immediately without losing the current context.
-
-C<o debug> without an argument lists the valid package names and the
-current set of packages in debugging mode. C<o debug> has built-in
-completion support.
-
-For debugging of CPAN data there is the C<dump> command which takes
-the same arguments as make/test/install and outputs each object's
-Data::Dumper dump. If an argument looks like a perl variable and
-contains one of C<$>, C<@> or C<%>, it is eval()ed and fed to
-Data::Dumper directly.
-
-=head2 Floppy, Zip, Offline Mode
-
-CPAN.pm works nicely without network too. If you maintain machines
-that are not networked at all, you should consider working with file:
-URLs. Of course, you have to collect your modules somewhere first. So
-you might use CPAN.pm to put together all you need on a networked
-machine. Then copy the $CPAN::Config->{keep_source_where} (but not
-$CPAN::Config->{build_dir}) directory on a floppy. This floppy is kind
-of a personal CPAN. CPAN.pm on the non-networked machines works nicely
-with this floppy. See also below the paragraph about CD-ROM support.
-
-=head2 Basic Utilities for Programmers
-
-=over 2
-
-=item has_inst($module)
-
-Returns true if the module is installed. Used to load all modules into
-the running CPAN.pm which are considered optional. The config variable
-C<dontload_list> can be used to intercept the C<has_inst()> call such
-that an optional module is not loaded despite being available. For
-example the following command will prevent that C<YAML.pm> is being
-loaded:
-
- cpan> o conf dontload_list push YAML
-
-See the source for details.
-
-=item has_usable($module)
-
-Returns true if the module is installed and is in a usable state. Only
-useful for a handful of modules that are used internally. See the
-source for details.
-
-=item instance($module)
-
-The constructor for all the singletons used to represent modules,
-distributions, authors and bundles. If the object already exists, this
-method returns the object, otherwise it calls the constructor.
-
-=back
-
-=head1 SECURITY
-
-There's no strong security layer in CPAN.pm. CPAN.pm helps you to
-install foreign, unmasked, unsigned code on your machine. We compare
-to a checksum that comes from the net just as the distribution file
-itself. But we try to make it easy to add security on demand:
-
-=head2 Cryptographically signed modules
-
-Since release 1.77 CPAN.pm has been able to verify cryptographically
-signed module distributions using Module::Signature. The CPAN modules
-can be signed by their authors, thus giving more security. The simple
-unsigned MD5 checksums that were used before by CPAN protect mainly
-against accidental file corruption.
-
-You will need to have Module::Signature installed, which in turn
-requires that you have at least one of Crypt::OpenPGP module or the
-command-line F<gpg> tool installed.
-
-You will also need to be able to connect over the Internet to the public
-keyservers, like pgp.mit.edu, and their port 11731 (the HKP protocol).
-
-The configuration parameter check_sigs is there to turn signature
-checking on or off.
-
-=head1 EXPORT
-
-Most functions in package CPAN are exported per default. The reason
-for this is that the primary use is intended for the cpan shell or for
-one-liners.
-
-=head1 ENVIRONMENT
-
-When the CPAN shell enters a subshell via the look command, it sets
-the environment CPAN_SHELL_LEVEL to 1 or increments it if it is
-already set.
-
-When CPAN runs, it sets the environment variable PERL5_CPAN_IS_RUNNING
-to the ID of the running process. It also sets
-PERL5_CPANPLUS_IS_RUNNING to prevent runaway processes which could
-happen with older versions of Module::Install.
-
-When running C<perl Makefile.PL>, the environment variable
-C<PERL5_CPAN_IS_EXECUTING> is set to the full path of the
-C<Makefile.PL> that is being executed. This prevents runaway processes
-with newer versions of Module::Install.
-
-When the config variable ftp_passive is set, all downloads will be run
-with the environment variable FTP_PASSIVE set to this value. This is
-in general a good idea as it influences both Net::FTP and LWP based
-connections. The same effect can be achieved by starting the cpan
-shell with this environment variable set. For Net::FTP alone, one can
-also always set passive mode by running libnetcfg.
-
-=head1 POPULATE AN INSTALLATION WITH LOTS OF MODULES
-
-Populating a freshly installed perl with my favorite modules is pretty
-easy if you maintain a private bundle definition file. To get a useful
-blueprint of a bundle definition file, the command autobundle can be used
-on the CPAN shell command line. This command writes a bundle definition
-file for all modules that are installed for the currently running perl
-interpreter. It's recommended to run this command only once and from then
-on maintain the file manually under a private name, say
-Bundle/my_bundle.pm. With a clever bundle file you can then simply say
-
- cpan> install Bundle::my_bundle
-
-then answer a few questions and then go out for a coffee.
-
-Maintaining a bundle definition file means keeping track of two
-things: dependencies and interactivity. CPAN.pm sometimes fails on
-calculating dependencies because not all modules define all MakeMaker
-attributes correctly, so a bundle definition file should specify
-prerequisites as early as possible. On the other hand, it's a bit
-annoying that many distributions need some interactive configuring. So
-what I try to accomplish in my private bundle file is to have the
-packages that need to be configured early in the file and the gentle
-ones later, so I can go out after a few minutes and leave CPAN.pm
-untended.
-
-=head1 WORKING WITH CPAN.pm BEHIND FIREWALLS
-
-Thanks to Graham Barr for contributing the following paragraphs about
-the interaction between perl, and various firewall configurations. For
-further information on firewalls, it is recommended to consult the
-documentation that comes with the ncftp program. If you are unable to
-go through the firewall with a simple Perl setup, it is very likely
-that you can configure ncftp so that it works for your firewall.
-
-=head2 Three basic types of firewalls
-
-Firewalls can be categorized into three basic types.
-
-=over 4
-
-=item http firewall
-
-This is where the firewall machine runs a web server and to access the
-outside world you must do it via the web server. If you set environment
-variables like http_proxy or ftp_proxy to a values beginning with http://
-or in your web browser you have to set proxy information then you know
-you are running an http firewall.
-
-To access servers outside these types of firewalls with perl (even for
-ftp) you will need to use LWP.
-
-=item ftp firewall
-
-This where the firewall machine runs an ftp server. This kind of
-firewall will only let you access ftp servers outside the firewall.
-This is usually done by connecting to the firewall with ftp, then
-entering a username like "user@outside.host.com"
-
-To access servers outside these type of firewalls with perl you
-will need to use Net::FTP.
-
-=item One way visibility
-
-I say one way visibility as these firewalls try to make themselves look
-invisible to the users inside the firewall. An FTP data connection is
-normally created by sending the remote server your IP address and then
-listening for the connection. But the remote server will not be able to
-connect to you because of the firewall. So for these types of firewall
-FTP connections need to be done in a passive mode.
-
-There are two that I can think off.
-
-=over 4
-
-=item SOCKS
-
-If you are using a SOCKS firewall you will need to compile perl and link
-it with the SOCKS library, this is what is normally called a 'socksified'
-perl. With this executable you will be able to connect to servers outside
-the firewall as if it is not there.
-
-=item IP Masquerade
-
-This is the firewall implemented in the Linux kernel, it allows you to
-hide a complete network behind one IP address. With this firewall no
-special compiling is needed as you can access hosts directly.
-
-For accessing ftp servers behind such firewalls you usually need to
-set the environment variable C<FTP_PASSIVE> or the config variable
-ftp_passive to a true value.
-
-=back
-
-=back
-
-=head2 Configuring lynx or ncftp for going through a firewall
-
-If you can go through your firewall with e.g. lynx, presumably with a
-command such as
-
- /usr/local/bin/lynx -pscott:tiger
-
-then you would configure CPAN.pm with the command
-
- o conf lynx "/usr/local/bin/lynx -pscott:tiger"
-
-That's all. Similarly for ncftp or ftp, you would configure something
-like
-
- o conf ncftp "/usr/bin/ncftp -f /home/scott/ncftplogin.cfg"
-
-Your mileage may vary...
-
-=head1 FAQ
-
-=over 4
-
-=item 1)
-
-I installed a new version of module X but CPAN keeps saying,
-I have the old version installed
-
-Most probably you B<do> have the old version installed. This can
-happen if a module installs itself into a different directory in the
-@INC path than it was previously installed. This is not really a
-CPAN.pm problem, you would have the same problem when installing the
-module manually. The easiest way to prevent this behaviour is to add
-the argument C<UNINST=1> to the C<make install> call, and that is why
-many people add this argument permanently by configuring
-
- o conf make_install_arg UNINST=1
-
-=item 2)
-
-So why is UNINST=1 not the default?
-
-Because there are people who have their precise expectations about who
-may install where in the @INC path and who uses which @INC array. In
-fine tuned environments C<UNINST=1> can cause damage.
-
-=item 3)
-
-I want to clean up my mess, and install a new perl along with
-all modules I have. How do I go about it?
-
-Run the autobundle command for your old perl and optionally rename the
-resulting bundle file (e.g. Bundle/mybundle.pm), install the new perl
-with the Configure option prefix, e.g.
-
- ./Configure -Dprefix=/usr/local/perl-5.6.78.9
-
-Install the bundle file you produced in the first step with something like
-
- cpan> install Bundle::mybundle
-
-and you're done.
-
-=item 4)
-
-When I install bundles or multiple modules with one command
-there is too much output to keep track of.
-
-You may want to configure something like
-
- o conf make_arg "| tee -ai /root/.cpan/logs/make.out"
- o conf make_install_arg "| tee -ai /root/.cpan/logs/make_install.out"
-
-so that STDOUT is captured in a file for later inspection.
-
-
-=item 5)
-
-I am not root, how can I install a module in a personal directory?
-
-First of all, you will want to use your own configuration, not the one
-that your root user installed. If you do not have permission to write
-in the cpan directory that root has configured, you will be asked if
-you want to create your own config. Answering "yes" will bring you into
-CPAN's configuration stage, using the system config for all defaults except
-things that have to do with CPAN's work directory, saving your choices to
-your MyConfig.pm file.
-
-You can also manually initiate this process with the following command:
-
- % perl -MCPAN -e 'mkmyconfig'
-
-or by running
-
- mkmyconfig
-
-from the CPAN shell.
-
-You will most probably also want to configure something like this:
-
- o conf makepl_arg "LIB=~/myperl/lib \
- INSTALLMAN1DIR=~/myperl/man/man1 \
- INSTALLMAN3DIR=~/myperl/man/man3 \
- INSTALLSCRIPT=~/myperl/bin \
- INSTALLBIN=~/myperl/bin"
-
-and then (oh joy) the equivalent command for Module::Build. That would
-be
-
- o conf mbuildpl_arg "--lib=~/myperl/lib \
- --installman1dir=~/myperl/man/man1 \
- --installman3dir=~/myperl/man/man3 \
- --installscript=~/myperl/bin \
- --installbin=~/myperl/bin"
-
-You can make this setting permanent like all C<o conf> settings with
-C<o conf commit> or by setting C<auto_commit> beforehand.
-
-You will have to add ~/myperl/man to the MANPATH environment variable
-and also tell your perl programs to look into ~/myperl/lib, e.g. by
-including
-
- use lib "$ENV{HOME}/myperl/lib";
-
-or setting the PERL5LIB environment variable.
-
-While we're speaking about $ENV{HOME}, it might be worth mentioning,
-that for Windows we use the File::HomeDir module that provides an
-equivalent to the concept of the home directory on Unix.
-
-Another thing you should bear in mind is that the UNINST parameter can
-be dangerous when you are installing into a private area because you
-might accidentally remove modules that other people depend on that are
-not using the private area.
-
-=item 6)
-
-How to get a package, unwrap it, and make a change before building it?
-
-Have a look at the C<look> (!) command.
-
-=item 7)
-
-I installed a Bundle and had a couple of fails. When I
-retried, everything resolved nicely. Can this be fixed to work
-on first try?
-
-The reason for this is that CPAN does not know the dependencies of all
-modules when it starts out. To decide about the additional items to
-install, it just uses data found in the META.yml file or the generated
-Makefile. An undetected missing piece breaks the process. But it may
-well be that your Bundle installs some prerequisite later than some
-depending item and thus your second try is able to resolve everything.
-Please note, CPAN.pm does not know the dependency tree in advance and
-cannot sort the queue of things to install in a topologically correct
-order. It resolves perfectly well IF all modules declare the
-prerequisites correctly with the PREREQ_PM attribute to MakeMaker or
-the C<requires> stanza of Module::Build. For bundles which fail and
-you need to install often, it is recommended to sort the Bundle
-definition file manually.
-
-=item 8)
-
-In our intranet we have many modules for internal use. How
-can I integrate these modules with CPAN.pm but without uploading
-the modules to CPAN?
-
-Have a look at the CPAN::Site module.
-
-=item 9)
-
-When I run CPAN's shell, I get an error message about things in my
-/etc/inputrc (or ~/.inputrc) file.
-
-These are readline issues and can only be fixed by studying readline
-configuration on your architecture and adjusting the referenced file
-accordingly. Please make a backup of the /etc/inputrc or ~/.inputrc
-and edit them. Quite often harmless changes like uppercasing or
-lowercasing some arguments solves the problem.
-
-=item 10)
-
-Some authors have strange characters in their names.
-
-Internally CPAN.pm uses the UTF-8 charset. If your terminal is
-expecting ISO-8859-1 charset, a converter can be activated by setting
-term_is_latin to a true value in your config file. One way of doing so
-would be
-
- cpan> o conf term_is_latin 1
-
-If other charset support is needed, please file a bugreport against
-CPAN.pm at rt.cpan.org and describe your needs. Maybe we can extend
-the support or maybe UTF-8 terminals become widely available.
-
-Note: this config variable is deprecated and will be removed in a
-future version of CPAN.pm. It will be replaced with the conventions
-around the family of $LANG and $LC_* environment variables.
-
-=item 11)
-
-When an install fails for some reason and then I correct the error
-condition and retry, CPAN.pm refuses to install the module, saying
-C<Already tried without success>.
-
-Use the force pragma like so
-
- force install Foo::Bar
-
-Or you can use
-
- look Foo::Bar
-
-and then 'make install' directly in the subshell.
-
-=item 12)
-
-How do I install a "DEVELOPER RELEASE" of a module?
-
-By default, CPAN will install the latest non-developer release of a
-module. If you want to install a dev release, you have to specify the
-partial path starting with the author id to the tarball you wish to
-install, like so:
-
- cpan> install KWILLIAMS/Module-Build-0.27_07.tar.gz
-
-Note that you can use the C<ls> command to get this path listed.
-
-=item 13)
-
-How do I install a module and all its dependencies from the commandline,
-without being prompted for anything, despite my CPAN configuration
-(or lack thereof)?
-
-CPAN uses ExtUtils::MakeMaker's prompt() function to ask its questions, so
-if you set the PERL_MM_USE_DEFAULT environment variable, you shouldn't be
-asked any questions at all (assuming the modules you are installing are
-nice about obeying that variable as well):
-
- % PERL_MM_USE_DEFAULT=1 perl -MCPAN -e 'install My::Module'
-
-=item 14)
-
-How do I create a Module::Build based Build.PL derived from an
-ExtUtils::MakeMaker focused Makefile.PL?
-
-http://search.cpan.org/search?query=Module::Build::Convert
-
-http://www.refcnt.org/papers/module-build-convert
-
-=item 15)
-
-What's the best CPAN site for me?
-
-The urllist config parameter is yours. You can add and remove sites at
-will. You should find out which sites have the best uptodateness,
-bandwidth, reliability, etc. and are topologically close to you. Some
-people prefer fast downloads, others uptodateness, others reliability.
-You decide which to try in which order.
-
-Henk P. Penning maintains a site that collects data about CPAN sites:
-
- http://www.cs.uu.nl/people/henkp/mirmon/cpan.html
-
-=item 16)
-
-Why do I get asked the same questions every time I start the shell?
-
-You can make your configuration changes permanent by calling the
-command C<o conf commit>. Alternatively set the C<auto_commit>
-variable to true by running C<o conf init auto_commit> and answering
-the following question with yes.
-
-=back
-
-=head1 COMPATIBILITY
-
-=head2 OLD PERL VERSIONS
-
-CPAN.pm is regularly tested to run under 5.004, 5.005, and assorted
-newer versions. It is getting more and more difficult to get the
-minimal prerequisites working on older perls. It is close to
-impossible to get the whole Bundle::CPAN working there. If you're in
-the position to have only these old versions, be advised that CPAN is
-designed to work fine without the Bundle::CPAN installed.
-
-To get things going, note that GBARR/Scalar-List-Utils-1.18.tar.gz is
-compatible with ancient perls and that File::Temp is listed as a
-prerequisite but CPAN has reasonable workarounds if it is missing.
-
-=head2 CPANPLUS
-
-This module and its competitor, the CPANPLUS module, are both much
-cooler than the other. CPAN.pm is older. CPANPLUS was designed to be
-more modular but it was never tried to make it compatible with CPAN.pm.
-
-=head1 SECURITY ADVICE
-
-This software enables you to upgrade software on your computer and so
-is inherently dangerous because the newly installed software may
-contain bugs and may alter the way your computer works or even make it
-unusable. Please consider backing up your data before every upgrade.
-
-=head1 BUGS
-
-Please report bugs via L<http://rt.cpan.org/>
-
-Before submitting a bug, please make sure that the traditional method
-of building a Perl module package from a shell by following the
-installation instructions of that package still works in your
-environment.
-
-=head1 AUTHOR
-
-Andreas Koenig C<< <andk@cpan.org> >>
-
-=head1 LICENSE
-
-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>
-
-=head1 TRANSLATIONS
-
-Kawai,Takanori provides a Japanese translation of this manpage at
-L<http://homepage3.nifty.com/hippo2000/perltips/CPAN.htm>
-
-=head1 SEE ALSO
-
-L<cpan>, L<CPAN::Nox>, L<CPAN::Version>
-
-=cut
-
-
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/CPAN/API/HOWTO.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/CPAN/API/HOWTO.pm
deleted file mode 100644
index e65a4bc9313..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/CPAN/API/HOWTO.pm
+++ /dev/null
@@ -1,44 +0,0 @@
-=head1 NAME
-
-CPAN::API::HOWTO - a recipe book for programming with CPAN.pm
-
-=head1 RECIPES
-
-All of these recipes assume that you have put "use CPAN" at the top of
-your program.
-
-=head2 What distribution contains a particular module?
-
- my $distribution = CPAN::Shell->expand(
- "Module", "Data::UUID"
- )->distribution()->pretty_id();
-
-This returns a string of the form "AUTHORID/TARBALL". If you want the
-full path and filename to this distribution on a CPAN mirror, then it is
-C<.../authors/id/A/AU/AUTHORID/TARBALL>.
-
-=head2 What modules does a particular distribution contain?
-
- CPAN::Index->reload();
- my @modules = CPAN::Shell->expand(
- "Distribution", "JHI/Graph-0.83.tar.gz"
- )->containsmods();
-
-You may also refer to a distribution in the form A/AU/AUTHORID/TARBALL.
-
-=head1 SEE ALSO
-
-the main CPAN.pm documentation
-
-=head1 LICENSE
-
-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>
-
-=head1 AUTHOR
-
-David Cantrell
-
-=cut
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/CPAN/Admin.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/CPAN/Admin.pm
deleted file mode 100644
index de8d7001840..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/CPAN/Admin.pm
+++ /dev/null
@@ -1,230 +0,0 @@
-package CPAN::Admin;
-use base CPAN;
-use CPAN; # old base.pm did not load CPAN on previous line
-use strict;
-use vars qw(@EXPORT $VERSION);
-use constant PAUSE_IP => "pause.perl.org";
-
-@EXPORT = qw(shell);
-$VERSION = "5.5";
-push @CPAN::Complete::COMMANDS, qw(register modsearch);
-$CPAN::Shell::COLOR_REGISTERED = 1;
-
-sub shell {
- CPAN::shell($_[0]||"admin's cpan> ",$_[1]);
-}
-
-sub CPAN::Shell::register {
- my($self,$mod,@rest) = @_;
- unless ($mod) {
- print "register called without argument\n";
- return;
- }
- if ($CPAN::META->has_inst("URI::Escape")) {
- require URI::Escape;
- } else {
- print "register requires URI::Escape installed, otherwise it cannot work\n";
- return;
- }
- print "Got request for mod[$mod]\n";
- if (@rest) {
- my $modline = join " ", $mod, @rest;
- print "Sending to PAUSE [$modline]\n";
- my $emodline = URI::Escape::uri_escape($modline, '^\w ');
- $emodline =~ s/ /+/g;
- my $url =
- sprintf("https://%s/pause/authenquery?pause99_add_mod_modid=".
- "%s;SUBMIT_pause99_add_mod_hint=hint",
- PAUSE_IP,
- $emodline,
- );
- print "url[$url]\n\n";
- print ">>>>Trying to open a netscape window<<<<\n";
- sleep 1;
- system("netscape","-remote","openURL($url)");
- return;
- }
- my $m = CPAN::Shell->expand("Module",$mod);
- unless (ref $m) {
- print "Could not determine the object for $mod\n";
- return;
- }
- my $id = $m->id;
- print "Found module id[$id] in database\n";
-
- if (exists $m->{RO} && $m->{RO}{chapterid}) {
- print "$id is already registered\n";
- return;
- }
-
- my(@namespace) = split /::/, $id;
- my $rootns = $namespace[0];
-
- # Tk, XML and Apache need special treatment
- if ($rootns=~/^(Bundle)\b/) {
- print "Bundles are not yet ready for registering\n";
- return;
- }
-
- # make a good suggestion for the chapter
- my(@simile) = CPAN::Shell->expand("Module","/^$rootns(:|\$)/");
- print "Found within this namespace ", join(", ", map { $_->id } @simile), "\n";
- my(%seench);
- for my $ch (map { exists $_->{RO} ? $_->{RO}{chapterid} : ""} @simile) {
- next unless $ch;
- $seench{$ch}=undef;
- }
- my(@seench) = sort grep {length($_)} keys %seench;
- my $reco_ch = "";
- if (@seench>1) {
- print "Found rootnamespace[$rootns] in the chapters [", join(", ", @seench), "]\n";
- $reco_ch = $seench[0];
- print "Picking $reco_ch\n";
- } elsif (@seench==1) {
- print "Found rootnamespace[$rootns] in the chapter[$seench[0]]\n";
- $reco_ch = $seench[0];
- } else {
- print "The new rootnamespace[$rootns] needs to be introduced. Oh well.\n";
- }
-
- # Look closer at the dist
- my $d = CPAN::Shell->expand("Distribution", $m->cpan_file);
- printf "Module comes with dist[%s]\n", $d->id;
- for my $contm ($d->containsmods) {
- if ($CPAN::META->exists("CPAN::Module",$contm)) {
- my $contm_obj = CPAN::Shell->expand("Module",$contm) or next;
- my $is_reg = exists $contm_obj->{RO} && $contm_obj->{RO}{description};
- printf(" in same dist: %s%s\n",
- $contm,
- $is_reg ? " already in modulelist" : "",
- );
- }
- }
-
- # get it so that m is better and we can inspect for XS
- CPAN::Shell->get($id);
- CPAN::Shell->m($id);
- CPAN::Shell->d($d->id);
-
- my $has_xs = 0;
- {
- my($mani,@mani);
- local $/ = "\n";
- open $mani, "$d->{build_dir}/MANIFEST" and @mani = <$mani>;
- my @xs = grep /\.xs\b/, @mani;
- if (@xs) {
- print "Found XS files: @xs";
- $has_xs=1;
- }
- }
- my $emodid = URI::Escape::uri_escape($id, '\W');
- my $ech = $reco_ch;
- $ech =~ s/ /+/g;
- my $description = $m->{MANPAGE} || "";
- $description =~ s/[A-Z]<//; # POD markup (and maybe more)
- $description =~ s/^\s+//; # leading spaces
- $description =~ s/>//; # POD
- $description =~ s/^\Q$id\E//; # usually this line starts with the modid
- $description =~ s/^[ \-]+//; # leading spaces and dashes
- substr($description,44) = "" if length($description)>44;
- $description = ucfirst($description);
- my $edescription = URI::Escape::uri_escape($description, '^\w ');
- $edescription =~ s/ /+/g;
- my $url =
- sprintf("https://%s/pause/authenquery?pause99_add_mod_modid=".
- "%s;pause99_add_mod_chapterid=%s;pause99_add_mod_statd=%s;".
- "pause99_add_mod_stats=%s;pause99_add_mod_statl=%s;".
- "pause99_add_mod_stati=%s;pause99_add_mod_description=%s;".
- "pause99_add_mod_userid=%s;SUBMIT_pause99_add_mod_preview=preview",
- PAUSE_IP,
- $emodid,
- $ech,
- "R",
- "d",
- $has_xs ? "c" : "p",
- "O",
- $edescription,
- $m->{RO}{CPAN_USERID},
- );
- print "$url\n\n";
- print ">>>>Trying to open a netscape window<<<<\n";
- system("netscape","-remote","openURL($url)");
-}
-
-sub CPAN::Shell::modsearch {
- my($self,@line) = @_;
- unless (@line) {
- print "modsearch called without argument\n";
- return;
- }
- my $request = join " ", @line;
- print "Got request[$request]\n";
- my $erequest = URI::Escape::uri_escape($request, '^\w ');
- $erequest =~ s/ /+/g;
- my $url =
- sprintf("http://www.xray.mpe.mpg.de/cgi-bin/w3glimpse/modules?query=%s".
- "&errors=0&case=on&maxfiles=100&maxlines=30",
- $erequest,
- );
- print "$url\n\n";
- print ">>>>Trying to open a netscape window<<<<\n";
- system("netscape","-remote","openURL('$url')");
-}
-
-1;
-
-__END__
-
-=head1 NAME
-
- CPAN::Admin - A CPAN Shell for CPAN admins
-
-=head1 SYNOPSIS
-
- perl -MCPAN::Admin -e shell
-
-=head1 STATUS
-
-Note: this module is currently not maintained. If you need it and fix
-it for your needs, please submit patches.
-
-=head1 DESCRIPTION
-
-CPAN::Admin is a subclass of CPAN that adds the commands C<register>
-and C<modsearch> to the CPAN shell.
-
-C<register> calls C<get> on the named module, assembles a couple of
-informations (description, language), and calls Netscape with the
--remote argument so that a form is filled with all the assembled
-informations and the registration can be performed with a single
-click. If the command line has more than one argument, register does
-not run a C<get>, instead it interprets the rest of the line as DSLI
-status, description, and userid and sends them to netscape such that
-the form is again mostly filled and can be edited or confirmed with a
-single click. CPAN::Admin never performs the submission click for you,
-it is only intended to fill in the form on PAUSE and leave the
-confirmation to you.
-
-C<modsearch> simply passes the arguments to the search engine for the
-modules@perl.org mailing list at http://www.xray.mpe.mpg.de where all
-registration requests are stored. It does so in the same way as
-register, namely with the C<netscape -remote> command.
-
-An experimental feature has also been added, namely to color already
-registered modules in listings. If you have Term::ANSIColor installed,
-the u, r, and m commands will show already registered modules in
-green.
-
-=head1 PREREQISITES
-
-URI::Escape, netscape browser available in the path, netscape must
-understand the -remote switch (as far as I know, this is only
-available on UNIX); coloring of registered modules is only available
-if Term::ANSIColor is installed.
-
-=head1 LICENSE
-
-This program is free software; you can redistribute it and/or
-modify it under the same terms as Perl itself.
-
-=cut
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/CPAN/Debug.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/CPAN/Debug.pm
deleted file mode 100644
index 086b6238520..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/CPAN/Debug.pm
+++ /dev/null
@@ -1,79 +0,0 @@
-# -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*-
-package CPAN::Debug;
-use strict;
-use vars qw($VERSION);
-
-$VERSION = sprintf "%.6f", substr(q$Rev: 2212 $,4)/1000000 + 5.4;
-# module is internal to CPAN.pm
-
-%CPAN::DEBUG = qw[
- CPAN 1
- Index 2
- InfoObj 4
- Author 8
- Distribution 16
- Bundle 32
- Module 64
- CacheMgr 128
- Complete 256
- FTP 512
- Shell 1024
- Eval 2048
- HandleConfig 4096
- Tarzip 8192
- Version 16384
- Queue 32768
- FirstTime 65536
-];
-
-$CPAN::DEBUG ||= 0;
-
-#-> sub CPAN::Debug::debug ;
-sub debug {
- my($self,$arg) = @_;
-
- my @caller;
- my $i = 0;
- while () {
- my(@c) = (caller($i))[0 .. ($i ? 3 : 2)];
- last unless defined $c[0];
- push @caller, \@c;
- for (0,3) {
- last if $_ > $#c;
- $c[$_] =~ s/.*:://;
- }
- for (1) {
- $c[$_] =~ s|.*/||;
- }
- last if ++$i>=3;
- }
- pop @caller;
- if ($CPAN::DEBUG{$caller[0][0]} & $CPAN::DEBUG) {
- if ($arg and ref $arg) {
- eval { require Data::Dumper };
- if ($@) {
- $CPAN::Frontend->myprint($arg->as_string);
- } else {
- $CPAN::Frontend->myprint(Data::Dumper::Dumper($arg));
- }
- } else {
- my $outer = "";
- local $" = ",";
- if (@caller>1) {
- $outer = ",[@{$caller[1]}]";
- }
- $CPAN::Frontend->myprint("Debug(@{$caller[0]}$outer): $arg\n");
- }
- }
-}
-
-1;
-
-__END__
-
-=head1 LICENSE
-
-This program is free software; you can redistribute it and/or
-modify it under the same terms as Perl itself.
-
-=cut
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/CPAN/DeferedCode.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/CPAN/DeferedCode.pm
deleted file mode 100644
index c57669b1778..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/CPAN/DeferedCode.pm
+++ /dev/null
@@ -1,16 +0,0 @@
-package CPAN::DeferedCode;
-
-use strict;
-use vars qw/$VERSION/;
-
-use overload fallback => 1, map { ($_ => 'run') } qw/
- bool "" 0+
-/;
-
-$VERSION = "5.50";
-
-sub run {
- $_[0]->();
-}
-
-1;
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/CPAN/FirstTime.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/CPAN/FirstTime.pm
deleted file mode 100644
index d5d3e21763e..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/CPAN/FirstTime.pm
+++ /dev/null
@@ -1,1636 +0,0 @@
-# -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*-
-package CPAN::Mirrored::By;
-use strict;
-
-sub new {
- my($self,@arg) = @_;
- bless [@arg], $self;
-}
-sub continent { shift->[0] }
-sub country { shift->[1] }
-sub url { shift->[2] }
-
-package CPAN::FirstTime;
-use strict;
-
-use ExtUtils::MakeMaker ();
-use FileHandle ();
-use File::Basename ();
-use File::Path ();
-use File::Spec ();
-use vars qw($VERSION $urllist);
-$VERSION = sprintf "%.6f", substr(q$Rev: 2229 $,4)/1000000 + 5.4;
-
-=head1 NAME
-
-CPAN::FirstTime - Utility for CPAN::Config file Initialization
-
-=head1 SYNOPSIS
-
-CPAN::FirstTime::init()
-
-=head1 DESCRIPTION
-
-The init routine asks a few questions and writes a CPAN/Config.pm or
-CPAN/MyConfig.pm file (depending on what it is currently using).
-
-In the following all questions and explanations regarding config
-variables are collected.
-
-=cut
-
-# down until the next =back the manpage must be parsed by the program
-# because the text is used in the init dialogues.
-
-=over 2
-
-=item auto_commit
-
-Normally CPAN.pm keeps config variables in memory and changes need to
-be saved in a separate 'o conf commit' command to make them permanent
-between sessions. If you set the 'auto_commit' option to true, changes
-to a config variable are always automatically committed to disk.
-
-Always commit changes to config variables to disk?
-
-=item build_cache
-
-CPAN.pm can limit the size of the disk area for keeping the build
-directories with all the intermediate files.
-
-Cache size for build directory (in MB)?
-
-=item build_dir
-
-Directory where the build process takes place?
-
-=item build_dir_reuse
-
-Until version 1.88 CPAN.pm never trusted the contents of the build_dir
-directory between sessions. Since 1.88_58 CPAN.pm has a YAML-based
-mechanism that makes it possible to share the contents of the
-build_dir/ directory between different sessions with the same version
-of perl. People who prefer to test things several days before
-installing will like this feature because it safes a lot of time.
-
-If you say yes to the following question, CPAN will try to store
-enough information about the build process so that it can pick up in
-future sessions at the same state of affairs as it left a previous
-session.
-
-Store and re-use state information about distributions between
-CPAN.pm sessions?
-
-=item build_requires_install_policy
-
-When a module declares another one as a 'build_requires' prerequisite
-this means that the other module is only needed for building or
-testing the module but need not be installed permanently. In this case
-you may wish to install that other module nonetheless or just keep it
-in the 'build_dir' directory to have it available only temporarily.
-Installing saves time on future installations but makes the perl
-installation bigger.
-
-You can choose if you want to always install (yes), never install (no)
-or be always asked. In the latter case you can set the default answer
-for the question to yes (ask/yes) or no (ask/no).
-
-Policy on installing 'build_requires' modules (yes, no, ask/yes,
-ask/no)?
-
-=item cache_metadata
-
-To considerably speed up the initial CPAN shell startup, it is
-possible to use Storable to create a cache of metadata. If Storable is
-not available, the normal index mechanism will be used.
-
-Note: this mechanism is not used when use_sqlite is on and SQLLite is
-running.
-
-Cache metadata (yes/no)?
-
-=item check_sigs
-
-CPAN packages can be digitally signed by authors and thus verified
-with the security provided by strong cryptography. The exact mechanism
-is defined in the Module::Signature module. While this is generally
-considered a good thing, it is not always convenient to the end user
-to install modules that are signed incorrectly or where the key of the
-author is not available or where some prerequisite for
-Module::Signature has a bug and so on.
-
-With the check_sigs parameter you can turn signature checking on and
-off. The default is off for now because the whole tool chain for the
-functionality is not yet considered mature by some. The author of
-CPAN.pm would recommend setting it to true most of the time and
-turning it off only if it turns out to be annoying.
-
-Note that if you do not have Module::Signature installed, no signature
-checks will be performed at all.
-
-Always try to check and verify signatures if a SIGNATURE file is in
-the package and Module::Signature is installed (yes/no)?
-
-=item colorize_output
-
-When you have Term::ANSIColor installed, you can turn on colorized
-output to have some visual differences between normal CPAN.pm output,
-warnings, debugging output, and the output of the modules being
-installed. Set your favorite colors after some experimenting with the
-Term::ANSIColor module.
-
-Do you want to turn on colored output?
-
-=item colorize_print
-
-Color for normal output?
-
-=item colorize_warn
-
-Color for warnings?
-
-=item colorize_debug
-
-Color for debugging messages?
-
-=item commandnumber_in_prompt
-
-The prompt of the cpan shell can contain the current command number
-for easier tracking of the session or be a plain string.
-
-Do you want the command number in the prompt (yes/no)?
-
-=item ftp_passive
-
-Shall we always set the FTP_PASSIVE environment variable when dealing
-with ftp download (yes/no)?
-
-=item getcwd
-
-CPAN.pm changes the current working directory often and needs to
-determine its own current working directory. Per default it uses
-Cwd::cwd but if this doesn't work on your system for some reason,
-alternatives can be configured according to the following table:
-
- cwd Cwd::cwd
- getcwd Cwd::getcwd
- fastcwd Cwd::fastcwd
- backtickcwd external command cwd
-
-Preferred method for determining the current working directory?
-
-=item histfile
-
-If you have one of the readline packages (Term::ReadLine::Perl,
-Term::ReadLine::Gnu, possibly others) installed, the interactive CPAN
-shell will have history support. The next two questions deal with the
-filename of the history file and with its size. If you do not want to
-set this variable, please hit SPACE RETURN to the following question.
-
-File to save your history?
-
-=item histsize
-
-Number of lines to save?
-
-=item inactivity_timeout
-
-Sometimes you may wish to leave the processes run by CPAN alone
-without caring about them. Because the Makefile.PL or the Build.PL
-sometimes contains question you're expected to answer, you can set a
-timer that will kill a 'perl Makefile.PL' process after the specified
-time in seconds.
-
-If you set this value to 0, these processes will wait forever. This is
-the default and recommended setting.
-
-Timeout for inactivity during {Makefile,Build}.PL?
-
-=item index_expire
-
-The CPAN indexes are usually rebuilt once or twice per hour, but the
-typical CPAN mirror mirrors only once or twice per day. Depending on
-the quality of your mirror and your desire to be on the bleeding edge,
-you may want to set the following value to more or less than one day
-(which is the default). It determines after how many days CPAN.pm
-downloads new indexes.
-
-Let the index expire after how many days?
-
-=item inhibit_startup_message
-
-When the CPAN shell is started it normally displays a greeting message
-that contains the running version and the status of readline support.
-
-Do you want to turn this message off?
-
-=item keep_source_where
-
-Unless you are accessing the CPAN on your filesystem via a file: URL,
-CPAN.pm needs to keep the source files it downloads somewhere. Please
-supply a directory where the downloaded files are to be kept.
-
-Download target directory?
-
-=item load_module_verbosity
-
-When CPAN.pm loads a module it needs for some optional feature, it
-usually reports about module name and version. Choose 'v' to get this
-message, 'none' to suppress it.
-
-Verbosity level for loading modules (none or v)?
-
-=item makepl_arg
-
-Every Makefile.PL is run by perl in a separate process. Likewise we
-run 'make' and 'make install' in separate processes. If you have
-any parameters (e.g. PREFIX, LIB, UNINST or the like) you want to
-pass to the calls, please specify them here.
-
-If you don't understand this question, just press ENTER.
-
-Typical frequently used settings:
-
- PREFIX=~/perl # non-root users (please see manual for more hints)
-
-Parameters for the 'perl Makefile.PL' command?
-
-=item make_arg
-
-Parameters for the 'make' command? Typical frequently used setting:
-
- -j3 # dual processor system (on GNU make)
-
-Your choice:
-
-=item make_install_arg
-
-Parameters for the 'make install' command?
-Typical frequently used setting:
-
- UNINST=1 # to always uninstall potentially conflicting files
-
-Your choice:
-
-=item make_install_make_command
-
-Do you want to use a different make command for 'make install'?
-Cautious people will probably prefer:
-
- su root -c make
- or
- sudo make
- or
- /path1/to/sudo -u admin_account /path2/to/make
-
-or some such. Your choice:
-
-=item mbuildpl_arg
-
-A Build.PL is run by perl in a separate process. Likewise we run
-'./Build' and './Build install' in separate processes. If you have any
-parameters you want to pass to the calls, please specify them here.
-
-Typical frequently used settings:
-
- --install_base /home/xxx # different installation directory
-
-Parameters for the 'perl Build.PL' command?
-
-=item mbuild_arg
-
-Parameters for the './Build' command? Setting might be:
-
- --extra_linker_flags -L/usr/foo/lib # non-standard library location
-
-Your choice:
-
-=item mbuild_install_arg
-
-Parameters for the './Build install' command? Typical frequently used
-setting:
-
- --uninst 1 # uninstall conflicting files
-
-Your choice:
-
-=item mbuild_install_build_command
-
-Do you want to use a different command for './Build install'? Sudo
-users will probably prefer:
-
- su root -c ./Build
- or
- sudo ./Build
- or
- /path1/to/sudo -u admin_account ./Build
-
-or some such. Your choice:
-
-=item pager
-
-What is your favorite pager program?
-
-=item prefer_installer
-
-When you have Module::Build installed and a module comes with both a
-Makefile.PL and a Build.PL, which shall have precedence?
-
-The main two standard installer modules are the old and well
-established ExtUtils::MakeMaker (for short: EUMM) which uses the
-Makefile.PL. And the next generation installer Module::Build (MB)
-which works with the Build.PL (and often comes with a Makefile.PL
-too). If a module comes only with one of the two we will use that one
-but if both are supplied then a decision must be made between EUMM and
-MB. See also http://rt.cpan.org/Ticket/Display.html?id=29235 for a
-discussion about the right default.
-
-Or, as a third option you can choose RAND which will make a random
-decision (something regular CPAN testers will enjoy).
-
-In case you can choose between running a Makefile.PL or a Build.PL,
-which installer would you prefer (EUMM or MB or RAND)?
-
-=item prefs_dir
-
-CPAN.pm can store customized build environments based on regular
-expressions for distribution names. These are YAML files where the
-default options for CPAN.pm and the environment can be overridden and
-dialog sequences can be stored that can later be executed by an
-Expect.pm object. The CPAN.pm distribution comes with some prefab YAML
-files that cover sample distributions that can be used as blueprints
-to store one own prefs. Please check out the distroprefs/ directory of
-the CPAN.pm distribution to get a quick start into the prefs system.
-
-Directory where to store default options/environment/dialogs for
-building modules that need some customization?
-
-=item prerequisites_policy
-
-The CPAN module can detect when a module which you are trying to build
-depends on prerequisites. If this happens, it can build the
-prerequisites for you automatically ('follow'), ask you for
-confirmation ('ask'), or just ignore them ('ignore'). Please set your
-policy to one of the three values.
-
-Policy on building prerequisites (follow, ask or ignore)?
-
-=item randomize_urllist
-
-CPAN.pm can introduce some randomness when using hosts for download
-that are configured in the urllist parameter. Enter a numeric value
-between 0 and 1 to indicate how often you want to let CPAN.pm try a
-random host from the urllist. A value of one specifies to always use a
-random host as the first try. A value of zero means no randomness at
-all. Anything in between specifies how often, on average, a random
-host should be tried first.
-
-Randomize parameter
-
-=item scan_cache
-
-By default, each time the CPAN module is started, cache scanning is
-performed to keep the cache size in sync. To prevent this, answer
-'never'.
-
-Perform cache scanning (atstart or never)?
-
-=item shell
-
-What is your favorite shell?
-
-=item show_unparsable_versions
-
-During the 'r' command CPAN.pm finds modules without version number.
-When the command finishes, it prints a report about this. If you
-want this report to be very verbose, say yes to the following
-variable.
-
-Show all individual modules that have no $VERSION?
-
-=item show_upload_date
-
-The 'd' and the 'm' command normally only show you information they
-have in their in-memory database and thus will never connect to the
-internet. If you set the 'show_upload_date' variable to true, 'm' and
-'d' will additionally show you the upload date of the module or
-distribution. Per default this feature is off because it may require a
-net connection to get at the upload date.
-
-Always try to show upload date with 'd' and 'm' command (yes/no)?
-
-=item show_zero_versions
-
-During the 'r' command CPAN.pm finds modules with a version number of
-zero. When the command finishes, it prints a report about this. If you
-want this report to be very verbose, say yes to the following
-variable.
-
-Show all individual modules that have a $VERSION of zero?
-
-=item tar_verbosity
-
-When CPAN.pm uses the tar command, which switch for the verbosity
-shall be used? Choose 'none' for quiet operation, 'v' for file
-name listing, 'vv' for full listing.
-
-Tar command verbosity level (none or v or vv)?
-
-=item term_is_latin
-
-The next option deals with the charset (aka character set) your
-terminal supports. In general, CPAN is English speaking territory, so
-the charset does not matter much but some CPAN have names that are
-outside the ASCII range. If your terminal supports UTF-8, you should
-say no to the next question. If it expects ISO-8859-1 (also known as
-LATIN1) then you should say yes. If it supports neither, your answer
-does not matter because you will not be able to read the names of some
-authors anyway. If you answer no, names will be output in UTF-8.
-
-Your terminal expects ISO-8859-1 (yes/no)?
-
-=item term_ornaments
-
-When using Term::ReadLine, you can turn ornaments on so that your
-input stands out against the output from CPAN.pm.
-
-Do you want to turn ornaments on?
-
-=item test_report
-
-The goal of the CPAN Testers project (http://testers.cpan.org/) is to
-test as many CPAN packages as possible on as many platforms as
-possible. This provides valuable feedback to module authors and
-potential users to identify bugs or platform compatibility issues and
-improves the overall quality and value of CPAN.
-
-One way you can contribute is to send test results for each module
-that you install. If you install the CPAN::Reporter module, you have
-the option to automatically generate and email test reports to CPAN
-Testers whenever you run tests on a CPAN package.
-
-See the CPAN::Reporter documentation for additional details and
-configuration settings. If your firewall blocks outgoing email,
-you will need to configure CPAN::Reporter before sending reports.
-
-Email test reports if CPAN::Reporter is installed (yes/no)?
-
-=item use_sqlite
-
-CPAN::SQLite is a layer between the index files that are downloaded
-from the CPAN and CPAN.pm that speeds up metadata queries and reduces
-memory consumption of CPAN.pm considerably.
-
-Use CPAN::SQLite if available? (yes/no)?
-
-=item yaml_load_code
-
-Both YAML.pm and YAML::Syck are capable of deserialising code. As this requires
-a string eval, which might be a security risk, you can use this option to
-enable or disable the deserialisation of code.
-
-Do you want to enable code deserialisation (yes/no)?
-
-=item yaml_module
-
-At the time of this writing there are two competing YAML modules,
-YAML.pm and YAML::Syck. The latter is faster but needs a C compiler
-installed on your system. There may be more alternative YAML
-conforming modules but at the time of writing a potential third
-player, YAML::Tiny, seemed not powerful enough to work with CPAN.pm.
-
-Which YAML implementation would you prefer?
-
-=back
-
-=head1 LICENSE
-
-This program is free software; you can redistribute it and/or
-modify it under the same terms as Perl itself.
-
-=cut
-
-use vars qw( %prompts );
-
-sub init {
- my($configpm, %args) = @_;
- use Config;
- # extra args after 'o conf init'
- my $matcher = $args{args} && @{$args{args}} ? $args{args}[0] : '';
- if ($matcher =~ /^\/(.*)\/$/) {
- # case /regex/ => take the first, ignore the rest
- $matcher = $1;
- shift @{$args{args}};
- if (@{$args{args}}) {
- local $" = " ";
- $CPAN::Frontend->mywarn("Ignoring excessive arguments '@{$args{args}}'");
- $CPAN::Frontend->mysleep(2);
- }
- } elsif (0 == length $matcher) {
- } elsif (0 && $matcher eq "~") { # extremely buggy, but a nice idea
- my @unconfigured = grep { not exists $CPAN::Config->{$_}
- or not defined $CPAN::Config->{$_}
- or not length $CPAN::Config->{$_}
- } keys %$CPAN::Config;
- $matcher = "\\b(".join("|", @unconfigured).")\\b";
- $CPAN::Frontend->mywarn("matcher[$matcher]");
- } else {
- # case WORD... => all arguments must be valid
- for my $arg (@{$args{args}}) {
- unless (exists $CPAN::HandleConfig::keys{$arg}) {
- $CPAN::Frontend->mywarn("'$arg' is not a valid configuration variable\n");
- return;
- }
- }
- $matcher = "\\b(".join("|",@{$args{args}}).")\\b";
- }
- CPAN->debug("matcher[$matcher]") if $CPAN::DEBUG;
-
- unless ($CPAN::VERSION) {
- require CPAN::Nox;
- }
- require CPAN::HandleConfig;
- CPAN::HandleConfig::require_myconfig_or_config();
- $CPAN::Config ||= {};
- local($/) = "\n";
- local($\) = "";
- local($|) = 1;
-
- my($ans,$default);
-
- #
- #= Files, directories
- #
-
- unless ($matcher) {
- $CPAN::Frontend->myprint($prompts{manual_config});
- }
-
- my $manual_conf;
-
- local *_real_prompt;
- if ( $args{autoconfig} ) {
- $manual_conf = "no";
- } elsif ($matcher) {
- $manual_conf = "yes";
- } else {
- my $_conf = prompt("Would you like me to configure as much as possible ".
- "automatically?", "yes");
- $manual_conf = ($_conf and $_conf =~ /^y/i) ? "no" : "yes";
- }
- CPAN->debug("manual_conf[$manual_conf]") if $CPAN::DEBUG;
- my $fastread;
- {
- if ($manual_conf =~ /^y/i) {
- $fastread = 0;
- } else {
- $fastread = 1;
- $CPAN::Config->{urllist} ||= [];
-
- local $^W = 0;
- # prototype should match that of &MakeMaker::prompt
- my $current_second = time;
- my $current_second_count = 0;
- my $i_am_mad = 0;
- *_real_prompt = sub {
- my($q,$a) = @_;
- my($ret) = defined $a ? $a : "";
- $CPAN::Frontend->myprint(sprintf qq{%s [%s]\n\n}, $q, $ret);
- eval { require Time::HiRes };
- unless ($@) {
- if (time == $current_second) {
- $current_second_count++;
- if ($current_second_count > 20) {
- # I don't like more than 20 prompts per second
- $i_am_mad++;
- }
- } else {
- $current_second = time;
- $current_second_count = 0;
- $i_am_mad-- if $i_am_mad>0;
- }
- if ($i_am_mad>0) {
- #require Carp;
- #Carp::cluck("SLEEEEEEEEPIIIIIIIIIIINGGGGGGGGGGG");
- Time::HiRes::sleep(0.1);
- }
- }
- $ret;
- };
- }
- }
-
- if (!$matcher or q{
- build_dir
- build_dir_reuse
- cpan_home
- keep_source_where
- prefs_dir
- } =~ /$matcher/) {
- $CPAN::Frontend->myprint($prompts{config_intro});
-
- if (!$matcher or 'cpan_home' =~ /$matcher/) {
- my $cpan_home = $CPAN::Config->{cpan_home}
- || File::Spec->catdir($ENV{HOME}, ".cpan");
-
- if (-d $cpan_home) {
- $CPAN::Frontend->myprint(qq{
-
-I see you already have a directory
- $cpan_home
-Shall we use it as the general CPAN build and cache directory?
-
-});
- } else {
- # no cpan-home, must prompt and get one
- $CPAN::Frontend->myprint($prompts{cpan_home_where});
- }
-
- $default = $cpan_home;
- my $loop = 0;
- my $last_ans;
- $CPAN::Frontend->myprint(" <cpan_home>\n");
- PROMPT: while ($ans = prompt("CPAN build and cache directory?",$default)) {
- print "\n";
- if (File::Spec->file_name_is_absolute($ans)) {
- my @cpan_home = split /[\/\\]/, $ans;
- DIR: for my $dir (@cpan_home) {
- if ($dir =~ /^~/ and (!$last_ans or $ans ne $last_ans)) {
- $CPAN::Frontend
- ->mywarn("Warning: a tilde in the path will be ".
- "taken as a literal tilde. Please ".
- "confirm again if you want to keep it\n");
- $last_ans = $default = $ans;
- next PROMPT;
- }
- }
- } else {
- require Cwd;
- my $cwd = Cwd::cwd();
- my $absans = File::Spec->catdir($cwd,$ans);
- $CPAN::Frontend->mywarn("The path '$ans' is not an ".
- "absolute path. Please specify ".
- "an absolute path\n");
- $default = $absans;
- next PROMPT;
- }
- eval { File::Path::mkpath($ans); }; # dies if it can't
- if ($@) {
- $CPAN::Frontend->mywarn("Couldn't create directory $ans.\n".
- "Please retry.\n");
- next PROMPT;
- }
- if (-d $ans && -w _) {
- last PROMPT;
- } else {
- $CPAN::Frontend->mywarn("Couldn't find directory $ans\n".
- "or directory is not writable. Please retry.\n");
- if (++$loop > 5) {
- $CPAN::Frontend->mydie("Giving up");
- }
- }
- }
- $CPAN::Config->{cpan_home} = $ans;
- }
-
- if (!$matcher or 'keep_source_where' =~ /$matcher/) {
- my_dflt_prompt("keep_source_where",
- File::Spec->catdir($CPAN::Config->{cpan_home},"sources"),
- $matcher,
- );
- }
-
- if (!$matcher or 'build_dir' =~ /$matcher/) {
- my_dflt_prompt("build_dir",
- File::Spec->catdir($CPAN::Config->{cpan_home},"build"),
- $matcher
- );
- }
-
- if (!$matcher or 'build_dir_reuse' =~ /$matcher/) {
- my_yn_prompt(build_dir_reuse => 1, $matcher);
- }
-
- if (!$matcher or 'prefs_dir' =~ /$matcher/) {
- my_dflt_prompt("prefs_dir",
- File::Spec->catdir($CPAN::Config->{cpan_home},"prefs"),
- $matcher
- );
- }
- }
-
- #
- #= Config: auto_commit
- #
-
- my_yn_prompt(auto_commit => 0, $matcher);
-
- #
- #= Cache size, Index expire
- #
-
- if (!$matcher or 'build_cache' =~ /$matcher/) {
- # large enough to build large dists like Tk
- my_dflt_prompt(build_cache => 100, $matcher);
- }
-
- if (!$matcher or 'index_expire' =~ /$matcher/) {
- my_dflt_prompt(index_expire => 1, $matcher);
- }
-
- if (!$matcher or 'scan_cache' =~ /$matcher/) {
- my_prompt_loop(scan_cache => 'atstart', $matcher, 'atstart|never');
- }
-
- #
- #= cache_metadata
- #
-
- my_yn_prompt(cache_metadata => 1, $matcher);
- my_yn_prompt(use_sqlite => 0, $matcher);
-
- #
- #= Do we follow PREREQ_PM?
- #
-
- if (!$matcher or 'prerequisites_policy' =~ /$matcher/) {
- my_prompt_loop(prerequisites_policy => 'ask', $matcher,
- 'follow|ask|ignore');
- }
-
- if (!$matcher or 'build_requires_install_policy' =~ /$matcher/) {
- my_prompt_loop(build_requires_install_policy => 'ask/yes', $matcher,
- 'yes|no|ask/yes|ask/no');
- }
-
- #
- #= Module::Signature
- #
- if (!$matcher or 'check_sigs' =~ /$matcher/) {
- my_yn_prompt(check_sigs => 0, $matcher);
- }
-
- #
- #= CPAN::Reporter
- #
- if (!$matcher or 'test_report' =~ /$matcher/) {
- my_yn_prompt(test_report => 0, $matcher);
- if (
- $CPAN::Config->{test_report} &&
- $CPAN::META->has_inst("CPAN::Reporter") &&
- CPAN::Reporter->can('configure')
- ) {
- $CPAN::Frontend->myprint("\nProceeding to configure CPAN::Reporter.\n");
- CPAN::Reporter::configure();
- $CPAN::Frontend->myprint("\nReturning to CPAN configuration.\n");
- }
- }
-
- #
- #= YAML vs. YAML::Syck
- #
- if (!$matcher or "yaml_module" =~ /$matcher/) {
- my_dflt_prompt(yaml_module => "YAML", $matcher);
- unless ($CPAN::META->has_inst($CPAN::Config->{yaml_module})) {
- $CPAN::Frontend->mywarn
- ("Warning (maybe harmless): '$CPAN::Config->{yaml_module}' not installed.\n");
- $CPAN::Frontend->mysleep(3);
- }
- }
-
- #
- #= YAML code deserialisation
- #
- if (!$matcher or "yaml_load_code" =~ /$matcher/) {
- my_yn_prompt(yaml_load_code => 0, $matcher);
- }
-
- #
- #= External programs
- #
-
- my @external_progs = qw/bzip2 gzip tar unzip
-
- make
-
- curl lynx wget ncftpget ncftp ftp
-
- gpg
-
- patch applypatch
- /;
- my(@path) = split /$Config{'path_sep'}/, $ENV{'PATH'};
- if (!$matcher or "@external_progs" =~ /$matcher/) {
- $CPAN::Frontend->myprint($prompts{external_progs});
-
- my $old_warn = $^W;
- local $^W if $^O eq 'MacOS';
- local $^W = $old_warn;
- my $progname;
- for $progname (@external_progs) {
- next if $matcher && $progname !~ /$matcher/;
- if ($^O eq 'MacOS') {
- $CPAN::Config->{$progname} = 'not_here';
- next;
- }
-
- my $progcall = $progname;
- unless ($matcher) {
- # we really don't need ncftp if we have ncftpget, but
- # if they chose this dialog via matcher, they shall have it
- next if $progname eq "ncftp" && $CPAN::Config->{ncftpget} gt " ";
- }
- my $path = $CPAN::Config->{$progname}
- || $Config::Config{$progname}
- || "";
- if (File::Spec->file_name_is_absolute($path)) {
- # testing existence is not good enough, some have these exe
- # extensions
-
- # warn "Warning: configured $path does not exist\n" unless -e $path;
- # $path = "";
- } elsif ($path =~ /^\s+$/) {
- # preserve disabled programs
- } else {
- $path = '';
- }
- unless ($path) {
- # e.g. make -> nmake
- $progcall = $Config::Config{$progname} if $Config::Config{$progname};
- }
-
- $path ||= find_exe($progcall,\@path);
- unless ($path) { # not -e $path, because find_exe already checked that
- local $"=";";
- $CPAN::Frontend->mywarn("Warning: $progcall not found in PATH[@path]\n");
- if ($progname eq "make") {
- $CPAN::Frontend->mywarn("ALERT: 'make' is an essential tool for ".
- "building perl Modules. Please make sure you ".
- "have 'make' (or some equivalent) ".
- "working.\n"
- );
- if ($^O eq "MSWin32") {
- $CPAN::Frontend->mywarn("
-Windows users may want to follow this procedure when back in the CPAN shell:
-
- look YVES/scripts/alien_nmake.pl
- perl alien_nmake.pl
-
-This will install nmake on your system which can be used as a 'make'
-substitute. You can then revisit this dialog with
-
- o conf init make
-
-");
- }
- }
- }
- $prompts{$progname} = "Where is your $progname program?";
- my_dflt_prompt($progname,$path,$matcher);
- }
- }
-
- if (!$matcher or 'pager' =~ /$matcher/) {
- my $path = $CPAN::Config->{'pager'} ||
- $ENV{PAGER} || find_exe("less",\@path) ||
- find_exe("more",\@path) || ($^O eq 'MacOS' ? $ENV{EDITOR} : 0 )
- || "more";
- my_dflt_prompt(pager => $path, $matcher);
- }
-
- if (!$matcher or 'shell' =~ /$matcher/) {
- my $path = $CPAN::Config->{'shell'};
- if ($path && File::Spec->file_name_is_absolute($path)) {
- $CPAN::Frontend->mywarn("Warning: configured $path does not exist\n")
- unless -e $path;
- $path = "";
- }
- $path ||= $ENV{SHELL};
- $path ||= $ENV{COMSPEC} if $^O eq "MSWin32";
- if ($^O eq 'MacOS') {
- $CPAN::Config->{'shell'} = 'not_here';
- } else {
- $path =~ s,\\,/,g if $^O eq 'os2'; # Cosmetic only
- my_dflt_prompt(shell => $path, $matcher);
- }
- }
-
- #
- # verbosity
- #
-
- if (!$matcher or 'tar_verbosity' =~ /$matcher/) {
- my_prompt_loop(tar_verbosity => 'v', $matcher,
- 'none|v|vv');
- }
-
- if (!$matcher or 'load_module_verbosity' =~ /$matcher/) {
- my_prompt_loop(load_module_verbosity => 'v', $matcher,
- 'none|v');
- }
-
- my_yn_prompt(inhibit_startup_message => 0, $matcher);
-
- #
- #= Installer, arguments to make etc.
- #
-
- if (!$matcher or 'prefer_installer' =~ /$matcher/) {
- my_prompt_loop(prefer_installer => 'MB', $matcher, 'MB|EUMM|RAND');
- }
-
- if (!$matcher or 'makepl_arg make_arg' =~ /$matcher/) {
- my_dflt_prompt(makepl_arg => "", $matcher);
- my_dflt_prompt(make_arg => "", $matcher);
- }
-
- require CPAN::HandleConfig;
- if (exists $CPAN::HandleConfig::keys{make_install_make_command}) {
- # as long as Windows needs $self->_build_command, we cannot
- # support sudo on windows :-)
- my_dflt_prompt(make_install_make_command => $CPAN::Config->{make} || "",
- $matcher);
- }
-
- my_dflt_prompt(make_install_arg => $CPAN::Config->{make_arg} || "",
- $matcher);
-
- my_dflt_prompt(mbuildpl_arg => "", $matcher);
- my_dflt_prompt(mbuild_arg => "", $matcher);
-
- if (exists $CPAN::HandleConfig::keys{mbuild_install_build_command}) {
- # as long as Windows needs $self->_build_command, we cannot
- # support sudo on windows :-)
- my_dflt_prompt(mbuild_install_build_command => "./Build", $matcher);
- }
-
- my_dflt_prompt(mbuild_install_arg => "", $matcher);
-
- #
- #= Alarm period
- #
-
- my_dflt_prompt(inactivity_timeout => 0, $matcher);
-
- #
- #= Proxies
- #
-
- my @proxy_vars = qw/ftp_proxy http_proxy no_proxy/;
- my @proxy_user_vars = qw/proxy_user proxy_pass/;
- if (!$matcher or "@proxy_vars @proxy_user_vars" =~ /$matcher/) {
- $CPAN::Frontend->myprint($prompts{proxy_intro});
-
- for (@proxy_vars) {
- $prompts{$_} = "Your $_?";
- my_dflt_prompt($_ => $ENV{$_}||"", $matcher);
- }
-
- if ($CPAN::Config->{ftp_proxy} ||
- $CPAN::Config->{http_proxy}) {
-
- $default = $CPAN::Config->{proxy_user} || $CPAN::LWP::UserAgent::USER || "";
-
- $CPAN::Frontend->myprint($prompts{proxy_user});
-
- if ($CPAN::Config->{proxy_user} = prompt("Your proxy user id?",$default)) {
- $CPAN::Frontend->myprint($prompts{proxy_pass});
-
- if ($CPAN::META->has_inst("Term::ReadKey")) {
- Term::ReadKey::ReadMode("noecho");
- } else {
- $CPAN::Frontend->myprint($prompts{password_warn});
- }
- $CPAN::Config->{proxy_pass} = prompt_no_strip("Your proxy password?");
- if ($CPAN::META->has_inst("Term::ReadKey")) {
- Term::ReadKey::ReadMode("restore");
- }
- $CPAN::Frontend->myprint("\n\n");
- }
- }
- }
-
- #
- #= how FTP works
- #
-
- my_yn_prompt(ftp_passive => 1, $matcher);
-
- #
- #= how cwd works
- #
-
- if (!$matcher or 'getcwd' =~ /$matcher/) {
- my_prompt_loop(getcwd => 'cwd', $matcher,
- 'cwd|getcwd|fastcwd|backtickcwd');
- }
-
- #
- #= the CPAN shell itself (prompt, color)
- #
-
- my_yn_prompt(commandnumber_in_prompt => 1, $matcher);
- my_yn_prompt(term_ornaments => 1, $matcher);
- if ("colorize_output colorize_print colorize_warn colorize_debug" =~ $matcher) {
- my_yn_prompt(colorize_output => 0, $matcher);
- if ($CPAN::Config->{colorize_output}) {
- if ($CPAN::META->has_inst("Term::ANSIColor")) {
- my $T="gYw";
- print " on_ on_y ".
- " on_ma on_\n";
- print " on_black on_red green ellow ".
- "on_blue genta on_cyan white\n";
-
- for my $FG ("", "bold",
- map {$_,"bold $_"} "black","red","green",
- "yellow","blue",
- "magenta",
- "cyan","white") {
- printf "%12s ", $FG;
- for my $BG ("",map {"on_$_"} qw(black red green yellow
- blue magenta cyan white)) {
- print $FG||$BG ?
- Term::ANSIColor::colored(" $T ","$FG $BG") : " $T ";
- }
- print "\n";
- }
- print "\n";
- }
- for my $tuple (
- ["colorize_print", "bold blue on_white"],
- ["colorize_warn", "bold red on_white"],
- ["colorize_debug", "black on_cyan"],
- ) {
- my_dflt_prompt($tuple->[0] => $tuple->[1], $matcher);
- if ($CPAN::META->has_inst("Term::ANSIColor")) {
- eval { Term::ANSIColor::color($CPAN::Config->{$tuple->[0]})};
- if ($@) {
- $CPAN::Config->{$tuple->[0]} = $tuple->[1];
- $CPAN::Frontend->mywarn($@."setting to default '$tuple->[1]'\n");
- }
- }
- }
- }
- }
-
- #
- #== term_is_latin
- #
-
- if (!$matcher or 'term_is_latin' =~ /$matcher/) {
- my_yn_prompt(term_is_latin => 1, $matcher);
- }
-
- #
- #== save history in file 'histfile'
- #
-
- if (!$matcher or 'histfile histsize' =~ /$matcher/) {
- $CPAN::Frontend->myprint($prompts{histfile_intro});
- defined($default = $CPAN::Config->{histfile}) or
- $default = File::Spec->catfile($CPAN::Config->{cpan_home},"histfile");
- my_dflt_prompt(histfile => $default, $matcher);
-
- if ($CPAN::Config->{histfile}) {
- defined($default = $CPAN::Config->{histsize}) or $default = 100;
- my_dflt_prompt(histsize => $default, $matcher);
- }
- }
-
- #
- #== do an ls on the m or the d command
- #
- my_yn_prompt(show_upload_date => 0, $matcher);
-
- #
- #== verbosity at the end of the r command
- #
- if (!$matcher
- or 'show_unparsable_versions' =~ /$matcher/
- or 'show_zero_versions' =~ /$matcher/
- ) {
- $CPAN::Frontend->myprint($prompts{show_unparsable_or_zero_versions_intro});
- my_yn_prompt(show_unparsable_versions => 0, $matcher);
- my_yn_prompt(show_zero_versions => 0, $matcher);
- }
-
- #
- #= MIRRORED.BY and conf_sites()
- #
-
- if ($matcher) {
- if ("urllist" =~ $matcher) {
- # conf_sites would go into endless loop with the smash prompt
- local *_real_prompt;
- *_real_prompt = \&CPAN::Shell::colorable_makemaker_prompt;
- conf_sites();
- }
- if ("randomize_urllist" =~ $matcher) {
- my_dflt_prompt(randomize_urllist => 0, $matcher);
- }
- } elsif ($fastread) {
- $CPAN::Frontend->myprint("Autoconfigured everything but 'urllist'.\n".
- "Please call 'o conf init urllist' to configure ".
- "your CPAN server(s) now!");
- } else {
- conf_sites();
- }
-
- $CPAN::Frontend->myprint("\n\n");
- if ($matcher && !$CPAN::Config->{auto_commit}) {
- $CPAN::Frontend->myprint("Please remember to call 'o conf commit' to ".
- "make the config permanent!\n\n");
- } else {
- CPAN::HandleConfig->commit($configpm);
- }
-}
-
-sub my_dflt_prompt {
- my ($item, $dflt, $m) = @_;
- my $default = $CPAN::Config->{$item} || $dflt;
-
- $DB::single = 1;
- if (!$m || $item =~ /$m/) {
- if (my $intro = $prompts{$item . "_intro"}) {
- $CPAN::Frontend->myprint($intro);
- }
- $CPAN::Frontend->myprint(" <$item>\n");
- $CPAN::Config->{$item} = prompt($prompts{$item}, $default);
- print "\n";
- } else {
- $CPAN::Config->{$item} = $default;
- }
-}
-
-sub my_yn_prompt {
- my ($item, $dflt, $m) = @_;
- my $default;
- defined($default = $CPAN::Config->{$item}) or $default = $dflt;
-
- # $DB::single = 1;
- if (!$m || $item =~ /$m/) {
- if (my $intro = $prompts{$item . "_intro"}) {
- $CPAN::Frontend->myprint($intro);
- }
- $CPAN::Frontend->myprint(" <$item>\n");
- my $ans = prompt($prompts{$item}, $default ? 'yes' : 'no');
- $CPAN::Config->{$item} = ($ans =~ /^[y1]/i ? 1 : 0);
- print "\n";
- } else {
- $CPAN::Config->{$item} = $default;
- }
-}
-
-sub my_prompt_loop {
- my ($item, $dflt, $m, $ok) = @_;
- my $default = $CPAN::Config->{$item} || $dflt;
- my $ans;
-
- $DB::single = 1;
- if (!$m || $item =~ /$m/) {
- $CPAN::Frontend->myprint($prompts{$item . "_intro"});
- $CPAN::Frontend->myprint(" <$item>\n");
- do { $ans = prompt($prompts{$item}, $default);
- } until $ans =~ /$ok/;
- $CPAN::Config->{$item} = $ans;
- print "\n";
- } else {
- $CPAN::Config->{$item} = $default;
- }
-}
-
-
-sub conf_sites {
- my $m = 'MIRRORED.BY';
- my $mby = File::Spec->catfile($CPAN::Config->{keep_source_where},$m);
- File::Path::mkpath(File::Basename::dirname($mby));
- if (-f $mby && -f $m && -M $m < -M $mby) {
- require File::Copy;
- File::Copy::copy($m,$mby) or die "Could not update $mby: $!";
- }
- my $loopcount = 0;
- local $^T = time;
- my $overwrite_local = 0;
- if ($mby && -f $mby && -M _ <= 60 && -s _ > 0) {
- my $mtime = localtime((stat _)[9]);
- my $prompt = qq{Found $mby as of $mtime
-
-I\'d use that as a database of CPAN sites. If that is OK for you,
-please answer 'y', but if you want me to get a new database now,
-please answer 'n' to the following question.
-
-Shall I use the local database in $mby?};
- my $ans = prompt($prompt,"y");
- $overwrite_local = 1 unless $ans =~ /^y/i;
- }
- while ($mby) {
- if ($overwrite_local) {
- $CPAN::Frontend->myprint(qq{Trying to overwrite $mby\n});
- $mby = CPAN::FTP->localize($m,$mby,3);
- $overwrite_local = 0;
- } elsif ( ! -f $mby ) {
- $CPAN::Frontend->myprint(qq{You have no $mby\n I\'m trying to fetch one\n});
- $mby = CPAN::FTP->localize($m,$mby,3);
- } elsif (-M $mby > 60 && $loopcount == 0) {
- $CPAN::Frontend->myprint(qq{Your $mby is older than 60 days,\n I\'m trying }.
- qq{to fetch one\n});
- $mby = CPAN::FTP->localize($m,$mby,3);
- $loopcount++;
- } elsif (-s $mby == 0) {
- $CPAN::Frontend->myprint(qq{You have an empty $mby,\n I\'m trying to fetch one\n});
- $mby = CPAN::FTP->localize($m,$mby,3);
- } else {
- last;
- }
- }
- local $urllist = [];
- read_mirrored_by($mby);
- bring_your_own();
- $CPAN::Config->{urllist} = $urllist;
-}
-
-sub find_exe {
- my($exe,$path) = @_;
- my($dir);
- #warn "in find_exe exe[$exe] path[@$path]";
- for $dir (@$path) {
- my $abs = File::Spec->catfile($dir,$exe);
- if (($abs = MM->maybe_command($abs))) {
- return $abs;
- }
- }
-}
-
-sub picklist {
- my($items,$prompt,$default,$require_nonempty,$empty_warning)=@_;
- CPAN->debug("picklist('$items','$prompt','$default','$require_nonempty',".
- "'$empty_warning')") if $CPAN::DEBUG;
- $default ||= '';
-
- my $pos = 0;
-
- my @nums;
- SELECTION: while (1) {
-
- # display, at most, 15 items at a time
- my $limit = $#{ $items } - $pos;
- $limit = 15 if $limit > 15;
-
- # show the next $limit items, get the new position
- $pos = display_some($items, $limit, $pos, $default);
- $pos = 0 if $pos >= @$items;
-
- my $num = prompt($prompt,$default);
-
- @nums = split (' ', $num);
- {
- my %seen;
- @nums = grep { !$seen{$_}++ } @nums;
- }
- my $i = scalar @$items;
- unrangify(\@nums);
- if (grep (/\D/ || $_ < 1 || $_ > $i, @nums)) {
- $CPAN::Frontend->mywarn("invalid items entered, try again\n");
- if ("@nums" =~ /\D/) {
- $CPAN::Frontend->mywarn("(we are expecting only numbers between 1 and $i)\n");
- }
- next SELECTION;
- }
- if ($require_nonempty && !@nums) {
- $CPAN::Frontend->mywarn("$empty_warning\n");
- }
- $CPAN::Frontend->myprint("\n");
-
- # a blank line continues...
- next SELECTION unless @nums;
- last;
- }
- for (@nums) { $_-- }
- @{$items}[@nums];
-}
-
-sub unrangify ($) {
- my($nums) = $_[0];
- my @nums2 = ();
- while (@{$nums||[]}) {
- my $n = shift @$nums;
- if ($n =~ /^(\d+)-(\d+)$/) {
- my @range = $1 .. $2;
- # warn "range[@range]";
- push @nums2, @range;
- } else {
- push @nums2, $n;
- }
- }
- push @$nums, @nums2;
-}
-
-sub display_some {
- my ($items, $limit, $pos, $default) = @_;
- $pos ||= 0;
-
- my @displayable = @$items[$pos .. ($pos + $limit)];
- for my $item (@displayable) {
- $CPAN::Frontend->myprint(sprintf "(%d) %s\n", ++$pos, $item);
- }
- my $hit_what = $default ? "SPACE RETURN" : "RETURN";
- $CPAN::Frontend->myprint(sprintf("%d more items, hit %s to show them\n",
- (@$items - $pos),
- $hit_what,
- ))
- if $pos < @$items;
- return $pos;
-}
-
-sub read_mirrored_by {
- my $local = shift or return;
- my(%all,$url,$expected_size,$default,$ans,$host,
- $dst,$country,$continent,@location);
- my $fh = FileHandle->new;
- $fh->open($local) or die "Couldn't open $local: $!";
- local $/ = "\012";
- while (<$fh>) {
- ($host) = /^([\w\.\-]+)/ unless defined $host;
- next unless defined $host;
- next unless /\s+dst_(dst|location)/;
- /location\s+=\s+\"([^\"]+)/ and @location = (split /\s*,\s*/, $1) and
- ($continent, $country) = @location[-1,-2];
- $continent =~ s/\s\(.*//;
- $continent =~ s/\W+$//; # if Jarkko doesn't know latitude/longitude
- /dst_dst\s+=\s+\"([^\"]+)/ and $dst = $1;
- next unless $host && $dst && $continent && $country;
- $all{$continent}{$country}{$dst} = CPAN::Mirrored::By->new($continent,$country,$dst);
- undef $host;
- $dst=$continent=$country="";
- }
- $fh->close;
- $CPAN::Config->{urllist} ||= [];
- my @previous_urls = @{$CPAN::Config->{urllist}};
-
- $CPAN::Frontend->myprint($prompts{urls_intro});
-
- my (@cont, $cont, %cont, @countries, @urls, %seen);
- my $no_previous_warn =
- "Sorry! since you don't have any existing picks, you must make a\n" .
- "geographic selection.";
- my $offer_cont = [sort keys %all];
- if (@previous_urls) {
- push @$offer_cont, "(edit previous picks)";
- $default = @$offer_cont;
- }
- @cont = picklist($offer_cont,
- "Select your continent (or several nearby continents)",
- $default,
- ! @previous_urls,
- $no_previous_warn);
-
-
- foreach $cont (@cont) {
- my @c = sort keys %{$all{$cont}};
- @cont{@c} = map ($cont, 0..$#c);
- @c = map ("$_ ($cont)", @c) if @cont > 1;
- push (@countries, @c);
- }
- if (@previous_urls && @countries) {
- push @countries, "(edit previous picks)";
- $default = @countries;
- }
-
- if (@countries) {
- @countries = picklist (\@countries,
- "Select your country (or several nearby countries)",
- $default,
- ! @previous_urls,
- $no_previous_warn);
- %seen = map (($_ => 1), @previous_urls);
- # hmmm, should take list of defaults from CPAN::Config->{'urllist'}...
- foreach $country (@countries) {
- next if $country =~ /edit previous picks/;
- (my $bare_country = $country) =~ s/ \(.*\)//;
- my @u = sort keys %{$all{$cont{$bare_country}}{$bare_country}};
- @u = grep (! $seen{$_}, @u);
- @u = map ("$_ ($bare_country)", @u)
- if @countries > 1;
- push (@urls, @u);
- }
- }
- push (@urls, map ("$_ (previous pick)", @previous_urls));
- my $prompt = "Select as many URLs as you like (by number),
-put them on one line, separated by blanks, hyphenated ranges allowed
- e.g. '1 4 5' or '7 1-4 8'";
- if (@previous_urls) {
- $default = join (' ', ((scalar @urls) - (scalar @previous_urls) + 1) ..
- (scalar @urls));
- $prompt .= "\n(or just hit RETURN to keep your previous picks)";
- }
-
- @urls = picklist (\@urls, $prompt, $default);
- foreach (@urls) { s/ \(.*\)//; }
- push @$urllist, @urls;
-}
-
-sub bring_your_own {
- my %seen = map (($_ => 1), @$urllist);
- my($ans,@urls);
- my $eacnt = 0; # empty answers
- do {
- my $prompt = "Enter another URL or RETURN to quit:";
- unless (%seen) {
- $prompt = qq{CPAN.pm needs at least one URL where it can fetch CPAN files from.
-
-Please enter your CPAN site:};
- }
- $ans = prompt ($prompt, "");
-
- if ($ans) {
- $ans =~ s|/?\z|/|; # has to end with one slash
- $ans = "file:$ans" unless $ans =~ /:/; # without a scheme is a file:
- if ($ans =~ /^\w+:\/./) {
- push @urls, $ans unless $seen{$ans}++;
- } else {
- $CPAN::Frontend->
- myprint(sprintf(qq{"%s" doesn\'t look like an URL at first sight.
-I\'ll ignore it for now.
-You can add it to your %s
-later if you\'re sure it\'s right.\n},
- $ans,
- $INC{'CPAN/MyConfig.pm'}
- || $INC{'CPAN/Config.pm'}
- || "configuration file",
- ));
- }
- } else {
- if (++$eacnt >= 5) {
- $CPAN::Frontend->
- mywarn("Giving up.\n");
- $CPAN::Frontend->mysleep(5);
- return;
- }
- }
- } while $ans || !%seen;
-
- push @$urllist, @urls;
- # xxx delete or comment these out when you're happy that it works
- $CPAN::Frontend->myprint("New set of picks:\n");
- map { $CPAN::Frontend->myprint(" $_\n") } @$urllist;
-}
-
-
-sub _strip_spaces {
- $_[0] =~ s/^\s+//; # no leading spaces
- $_[0] =~ s/\s+\z//; # no trailing spaces
-}
-
-sub prompt ($;$) {
- unless (defined &_real_prompt) {
- *_real_prompt = \&CPAN::Shell::colorable_makemaker_prompt;
- }
- my $ans = _real_prompt(@_);
-
- _strip_spaces($ans);
-
- return $ans;
-}
-
-
-sub prompt_no_strip ($;$) {
- return _real_prompt(@_);
-}
-
-
-BEGIN {
-
-my @prompts = (
-
-manual_config => qq[
-
-CPAN is the world-wide archive of perl resources. It consists of about
-300 sites that all replicate the same contents around the globe. Many
-countries have at least one CPAN site already. The resources found on
-CPAN are easily accessible with the CPAN.pm module. If you want to use
-CPAN.pm, lots of things have to be configured. Fortunately, most of
-them can be determined automatically. If you prefer the automatic
-configuration, answer 'yes' below.
-
-If you prefer to enter a dialog instead, you can answer 'no' to this
-question and I'll let you configure in small steps one thing after the
-other. (Note: you can revisit this dialog anytime later by typing 'o
-conf init' at the cpan prompt.)
-],
-
-config_intro => qq{
-
-The following questions are intended to help you with the
-configuration. The CPAN module needs a directory of its own to cache
-important index files and maybe keep a temporary mirror of CPAN files.
-This may be a site-wide or a personal directory.},
-
-# cpan_home => qq{ },
-
-cpan_home_where => qq{
-
-First of all, I'd like to create this directory. Where?
-
-},
-
-external_progs => qq{
-
-The CPAN module will need a few external programs to work properly.
-Please correct me, if I guess the wrong path for a program. Don't
-panic if you do not have some of them, just press ENTER for those. To
-disable the use of a program, you can type a space followed by ENTER.
-
-},
-
-proxy_intro => qq{
-
-If you're accessing the net via proxies, you can specify them in the
-CPAN configuration or via environment variables. The variable in
-the \$CPAN::Config takes precedence.
-
-},
-
-proxy_user => qq{
-
-If your proxy is an authenticating proxy, you can store your username
-permanently. If you do not want that, just press RETURN. You will then
-be asked for your username in every future session.
-
-},
-
-proxy_pass => qq{
-
-Your password for the authenticating proxy can also be stored
-permanently on disk. If this violates your security policy, just press
-RETURN. You will then be asked for the password in every future
-session.
-
-},
-
-urls_intro => qq{
-
-Now we need to know where your favorite CPAN sites are located. Push
-a few sites onto the array (just in case the first on the array won\'t
-work). If you are mirroring CPAN to your local workstation, specify a
-file: URL.
-
-First, pick a nearby continent and country by typing in the number(s)
-in front of the item(s) you want to select. You can pick several of
-each, separated by spaces. Then, you will be presented with a list of
-URLs of CPAN mirrors in the countries you selected, along with
-previously selected URLs. Select some of those URLs, or just keep the
-old list. Finally, you will be prompted for any extra URLs -- file:,
-ftp:, or http: -- that host a CPAN mirror.
-
-},
-
-password_warn => qq{
-
-Warning: Term::ReadKey seems not to be available, your password will
-be echoed to the terminal!
-
-},
-
- );
-
-die "Coding error in \@prompts declaration. Odd number of elements, above"
- if (@prompts % 2);
-
-%prompts = @prompts;
-
-if (scalar(keys %prompts) != scalar(@prompts)/2) {
- my %already;
- for my $item (0..$#prompts) {
- next if $item % 2;
- die "$prompts[$item] is duplicated\n" if $already{$prompts[$item]}++;
- }
-}
-
-local *FH;
-my $pmfile = __FILE__;
-open FH, $pmfile or die "Could not open '$pmfile': $!";
-local $/ = "";
-my @podpara;
-while (<FH>) {
- next if 1 .. /^=over/;
- chomp;
- push @podpara, $_;
- last if /^=back/;
-}
-pop @podpara;
-while (@podpara) {
- warn "Alert: cannot parse my own manpage for init dialog" unless $podpara[0] =~ s/^=item\s+//;
- my $name = shift @podpara;
- my @para;
- while (@podpara && $podpara[0] !~ /^=item/) {
- push @para, shift @podpara;
- }
- $prompts{$name} = pop @para;
- if (@para) {
- $prompts{$name . "_intro"} = join "", map { "$_\n\n" } @para;
- }
-}
-
-} # EOBEGIN
-
-1;
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/CPAN/HandleConfig.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/CPAN/HandleConfig.pm
deleted file mode 100644
index ec0aefdab98..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/CPAN/HandleConfig.pm
+++ /dev/null
@@ -1,719 +0,0 @@
-package CPAN::HandleConfig;
-use strict;
-use vars qw(%can %keys $loading $VERSION);
-
-$VERSION = sprintf "%.6f", substr(q$Rev: 2212 $,4)/1000000 + 5.4;
-
-%can = (
- commit => "Commit changes to disk",
- defaults => "Reload defaults from disk",
- help => "Short help about 'o conf' usage",
- init => "Interactive setting of all options",
-);
-
-# Q: where is the "How do I add a new config option" HOWTO?
-# A1: svn diff -r 757:758 # where dagolden added test_report
-# A2: svn diff -r 985:986 # where andk added yaml_module
-%keys = map { $_ => undef }
- (
- "applypatch",
- "auto_commit",
- "build_cache",
- "build_dir",
- "build_dir_reuse",
- "build_requires_install_policy",
- "bzip2",
- "cache_metadata",
- "check_sigs",
- "colorize_debug",
- "colorize_output",
- "colorize_print",
- "colorize_warn",
- "commandnumber_in_prompt",
- "commands_quote",
- "cpan_home",
- "curl",
- "dontload_hash", # deprecated after 1.83_68 (rev. 581)
- "dontload_list",
- "ftp",
- "ftp_passive",
- "ftp_proxy",
- "getcwd",
- "gpg",
- "gzip",
- "histfile",
- "histsize",
- "http_proxy",
- "inactivity_timeout",
- "index_expire",
- "inhibit_startup_message",
- "keep_source_where",
- "load_module_verbosity",
- "lynx",
- "make",
- "make_arg",
- "make_install_arg",
- "make_install_make_command",
- "makepl_arg",
- "mbuild_arg",
- "mbuild_install_arg",
- "mbuild_install_build_command",
- "mbuildpl_arg",
- "ncftp",
- "ncftpget",
- "no_proxy",
- "pager",
- "password",
- "patch",
- "prefer_installer",
- "prefs_dir",
- "prerequisites_policy",
- "proxy_pass",
- "proxy_user",
- "randomize_urllist",
- "scan_cache",
- "shell",
- "show_unparsable_versions",
- "show_upload_date",
- "show_zero_versions",
- "tar",
- "tar_verbosity",
- "term_is_latin",
- "term_ornaments",
- "test_report",
- "unzip",
- "urllist",
- "use_sqlite",
- "username",
- "wait_list",
- "wget",
- "yaml_load_code",
- "yaml_module",
- );
-
-my %prefssupport = map { $_ => 1 }
- (
- "build_requires_install_policy",
- "check_sigs",
- "make",
- "make_install_make_command",
- "prefer_installer",
- "test_report",
- );
-
-if ($^O eq "MSWin32") {
- for my $k (qw(
- mbuild_install_build_command
- make_install_make_command
- )) {
- delete $keys{$k};
- if (exists $CPAN::Config->{$k}) {
- for ("deleting previously set config variable '$k' => '$CPAN::Config->{$k}'") {
- $CPAN::Frontend ? $CPAN::Frontend->mywarn($_) : warn $_;
- }
- delete $CPAN::Config->{$k};
- }
- }
-}
-
-# returns true on successful action
-sub edit {
- my($self,@args) = @_;
- return unless @args;
- CPAN->debug("self[$self]args[".join(" | ",@args)."]");
- my($o,$str,$func,$args,$key_exists);
- $o = shift @args;
- $DB::single = 1;
- if($can{$o}) {
- $self->$o(args => \@args); # o conf init => sub init => sub load
- return 1;
- } else {
- CPAN->debug("o[$o]") if $CPAN::DEBUG;
- unless (exists $keys{$o}) {
- $CPAN::Frontend->mywarn("Warning: unknown configuration variable '$o'\n");
- }
- my $changed;
-
-
- # one day I used randomize_urllist for a boolean, so we must
- # list them explicitly --ak
- if (0) {
- } elsif ($o =~ /^(wait_list|urllist|dontload_list)$/) {
-
- #
- # ARRAYS
- #
-
- $func = shift @args;
- $func ||= "";
- CPAN->debug("func[$func]args[@args]") if $CPAN::DEBUG;
- # Let's avoid eval, it's easier to comprehend without.
- if ($func eq "push") {
- push @{$CPAN::Config->{$o}}, @args;
- $changed = 1;
- } elsif ($func eq "pop") {
- pop @{$CPAN::Config->{$o}};
- $changed = 1;
- } elsif ($func eq "shift") {
- shift @{$CPAN::Config->{$o}};
- $changed = 1;
- } elsif ($func eq "unshift") {
- unshift @{$CPAN::Config->{$o}}, @args;
- $changed = 1;
- } elsif ($func eq "splice") {
- my $offset = shift @args || 0;
- my $length = shift @args || 0;
- splice @{$CPAN::Config->{$o}}, $offset, $length, @args; # may warn
- $changed = 1;
- } elsif ($func) {
- $CPAN::Config->{$o} = [$func, @args];
- $changed = 1;
- } else {
- $self->prettyprint($o);
- }
- if ($changed) {
- if ($o eq "urllist") {
- # reset the cached values
- undef $CPAN::FTP::Thesite;
- undef $CPAN::FTP::Themethod;
- $CPAN::Index::LAST_TIME = 0;
- } elsif ($o eq "dontload_list") {
- # empty it, it will be built up again
- $CPAN::META->{dontload_hash} = {};
- }
- }
- } elsif ($o =~ /_hash$/) {
-
- #
- # HASHES
- #
-
- if (@args==1 && $args[0] eq "") {
- @args = ();
- } elsif (@args % 2) {
- push @args, "";
- }
- $CPAN::Config->{$o} = { @args };
- $changed = 1;
- } else {
-
- #
- # SCALARS
- #
-
- if (defined $args[0]) {
- $CPAN::CONFIG_DIRTY = 1;
- $CPAN::Config->{$o} = $args[0];
- $changed = 1;
- }
- $self->prettyprint($o)
- if exists $keys{$o} or defined $CPAN::Config->{$o};
- }
- if ($changed) {
- if ($CPAN::Config->{auto_commit}) {
- $self->commit;
- } else {
- $CPAN::CONFIG_DIRTY = 1;
- $CPAN::Frontend->myprint("Please use 'o conf commit' to ".
- "make the config permanent!\n\n");
- }
- }
- }
-}
-
-sub prettyprint {
- my($self,$k) = @_;
- my $v = $CPAN::Config->{$k};
- if (ref $v) {
- my(@report);
- if (ref $v eq "ARRAY") {
- @report = map {"\t$_ \[$v->[$_]]\n"} 0..$#$v;
- } else {
- @report = map
- {
- sprintf "\t%-18s => %s\n",
- "[$_]",
- defined $v->{$_} ? "[$v->{$_}]" : "undef"
- } keys %$v;
- }
- $CPAN::Frontend->myprint(
- join(
- "",
- sprintf(
- " %-18s\n",
- $k
- ),
- @report
- )
- );
- } elsif (defined $v) {
- $CPAN::Frontend->myprint(sprintf " %-18s [%s]\n", $k, $v);
- } else {
- $CPAN::Frontend->myprint(sprintf " %-18s undef\n", $k);
- }
-}
-
-sub commit {
- my($self,@args) = @_;
- CPAN->debug("args[@args]") if $CPAN::DEBUG;
- if ($CPAN::RUN_DEGRADED) {
- $CPAN::Frontend->mydie(
- "'o conf commit' disabled in ".
- "degraded mode. Maybe try\n".
- " !undef \$CPAN::RUN_DEGRADED\n"
- );
- }
- my $configpm;
- if (@args) {
- if ($args[0] eq "args") {
- # we have not signed that contract
- } else {
- $configpm = $args[0];
- }
- }
- unless (defined $configpm) {
- $configpm ||= $INC{"CPAN/MyConfig.pm"};
- $configpm ||= $INC{"CPAN/Config.pm"};
- $configpm || Carp::confess(q{
-CPAN::Config::commit called without an argument.
-Please specify a filename where to save the configuration or try
-"o conf init" to have an interactive course through configing.
-});
- }
- my($mode);
- if (-f $configpm) {
- $mode = (stat $configpm)[2];
- if ($mode && ! -w _) {
- Carp::confess("$configpm is not writable");
- }
- }
-
- my $msg;
- $msg = <<EOF unless $configpm =~ /MyConfig/;
-
-# This is CPAN.pm's systemwide configuration file. This file provides
-# defaults for users, and the values can be changed in a per-user
-# configuration file. The user-config file is being looked for as
-# ~/.cpan/CPAN/MyConfig.pm.
-
-EOF
- $msg ||= "\n";
- my($fh) = FileHandle->new;
- rename $configpm, "$configpm~" if -f $configpm;
- open $fh, ">$configpm" or
- $CPAN::Frontend->mydie("Couldn't open >$configpm: $!");
- $fh->print(qq[$msg\$CPAN::Config = \{\n]);
- foreach (sort keys %$CPAN::Config) {
- unless (exists $keys{$_}) {
- # do not drop them: forward compatibility!
- $CPAN::Frontend->mywarn("Unknown config variable '$_'\n");
- next;
- }
- $fh->print(
- " '$_' => ",
- $self->neatvalue($CPAN::Config->{$_}),
- ",\n"
- );
- }
-
- $fh->print("};\n1;\n__END__\n");
- close $fh;
-
- #$mode = 0444 | ( $mode & 0111 ? 0111 : 0 );
- #chmod $mode, $configpm;
-###why was that so? $self->defaults;
- $CPAN::Frontend->myprint("commit: wrote '$configpm'\n");
- $CPAN::CONFIG_DIRTY = 0;
- 1;
-}
-
-# stolen from MakeMaker; not taking the original because it is buggy;
-# bugreport will have to say: keys of hashes remain unquoted and can
-# produce syntax errors
-sub neatvalue {
- my($self, $v) = @_;
- return "undef" unless defined $v;
- my($t) = ref $v;
- unless ($t) {
- $v =~ s/\\/\\\\/g;
- return "q[$v]";
- }
- if ($t eq 'ARRAY') {
- my(@m, @neat);
- push @m, "[";
- foreach my $elem (@$v) {
- push @neat, "q[$elem]";
- }
- push @m, join ", ", @neat;
- push @m, "]";
- return join "", @m;
- }
- return "$v" unless $t eq 'HASH';
- my(@m, $key, $val);
- while (($key,$val) = each %$v) {
- last unless defined $key; # cautious programming in case (undef,undef) is true
- push(@m,"q[$key]=>".$self->neatvalue($val)) ;
- }
- return "{ ".join(', ',@m)." }";
-}
-
-sub defaults {
- my($self) = @_;
- if ($CPAN::RUN_DEGRADED) {
- $CPAN::Frontend->mydie(
- "'o conf defaults' disabled in ".
- "degraded mode. Maybe try\n".
- " !undef \$CPAN::RUN_DEGRADED\n"
- );
- }
- my $done;
- for my $config (qw(CPAN/MyConfig.pm CPAN/Config.pm)) {
- if ($INC{$config}) {
- CPAN->debug("INC{'$config'}[$INC{$config}]") if $CPAN::DEBUG;
- CPAN::Shell->_reload_this($config,{reloforce => 1});
- $CPAN::Frontend->myprint("'$INC{$config}' reread\n");
- last;
- }
- }
- $CPAN::CONFIG_DIRTY = 0;
- 1;
-}
-
-=head2 C<< CLASS->safe_quote ITEM >>
-
-Quotes an item to become safe against spaces
-in shell interpolation. An item is enclosed
-in double quotes if:
-
- - the item contains spaces in the middle
- - the item does not start with a quote
-
-This happens to avoid shell interpolation
-problems when whitespace is present in
-directory names.
-
-This method uses C<commands_quote> to determine
-the correct quote. If C<commands_quote> is
-a space, no quoting will take place.
-
-
-if it starts and ends with the same quote character: leave it as it is
-
-if it contains no whitespace: leave it as it is
-
-if it contains whitespace, then
-
-if it contains quotes: better leave it as it is
-
-else: quote it with the correct quote type for the box we're on
-
-=cut
-
-{
- # Instead of patching the guess, set commands_quote
- # to the right value
- my ($quotes,$use_quote)
- = $^O eq 'MSWin32'
- ? ('"', '"')
- : (q{"'}, "'")
- ;
-
- sub safe_quote {
- my ($self, $command) = @_;
- # Set up quote/default quote
- my $quote = $CPAN::Config->{commands_quote} || $quotes;
-
- if ($quote ne ' '
- and defined($command )
- and $command =~ /\s/
- and $command !~ /[$quote]/) {
- return qq<$use_quote$command$use_quote>
- }
- return $command;
- }
-}
-
-sub init {
- my($self,@args) = @_;
- CPAN->debug("self[$self]args[".join(",",@args)."]");
- $self->load(doit => 1, @args);
- 1;
-}
-
-# This is a piece of repeated code that is abstracted here for
-# maintainability. RMB
-#
-sub _configpmtest {
- my($configpmdir, $configpmtest) = @_;
- if (-w $configpmtest) {
- return $configpmtest;
- } elsif (-w $configpmdir) {
- #_#_# following code dumped core on me with 5.003_11, a.k.
- my $configpm_bak = "$configpmtest.bak";
- unlink $configpm_bak if -f $configpm_bak;
- if( -f $configpmtest ) {
- if( rename $configpmtest, $configpm_bak ) {
- $CPAN::Frontend->mywarn(<<END);
-Old configuration file $configpmtest
- moved to $configpm_bak
-END
- }
- }
- my $fh = FileHandle->new;
- if ($fh->open(">$configpmtest")) {
- $fh->print("1;\n");
- return $configpmtest;
- } else {
- # Should never happen
- Carp::confess("Cannot open >$configpmtest");
- }
- } else { return }
-}
-
-sub require_myconfig_or_config () {
- return if $INC{"CPAN/MyConfig.pm"};
- local @INC = @INC;
- my $home = home();
- unshift @INC, File::Spec->catdir($home,'.cpan');
- eval { require CPAN::MyConfig };
- my $err_myconfig = $@;
- if ($err_myconfig and $err_myconfig !~ m#locate CPAN/MyConfig\.pm#) {
- die "Error while requiring CPAN::MyConfig:\n$err_myconfig";
- }
- unless ($INC{"CPAN/MyConfig.pm"}) { # this guy has settled his needs already
- eval {require CPAN::Config;}; # not everybody has one
- my $err_config = $@;
- if ($err_config and $err_config !~ m#locate CPAN/Config\.pm#) {
- die "Error while requiring CPAN::Config:\n$err_config";
- }
- }
-}
-
-sub home () {
- my $home;
- if ($CPAN::META->has_usable("File::HomeDir")) {
- $home = File::HomeDir->my_data;
- unless (defined $home) {
- $home = File::HomeDir->my_home
- }
- }
- unless (defined $home) {
- $home = $ENV{HOME};
- }
- $home;
-}
-
-sub load {
- my($self, %args) = @_;
- $CPAN::Be_Silent++ if $args{be_silent};
- my $doit;
- $doit = delete $args{doit};
-
- use Carp;
- require_myconfig_or_config;
- my @miss = $self->missing_config_data;
- return unless $doit || @miss;
- return if $loading;
- $loading++;
-
- require CPAN::FirstTime;
- my($configpm,$fh,$redo);
- $redo ||= "";
- if (defined $INC{"CPAN/Config.pm"} && -w $INC{"CPAN/Config.pm"}) {
- $configpm = $INC{"CPAN/Config.pm"};
- $redo++;
- } elsif (defined $INC{"CPAN/MyConfig.pm"} && -w $INC{"CPAN/MyConfig.pm"}) {
- $configpm = $INC{"CPAN/MyConfig.pm"};
- $redo++;
- } else {
- my($path_to_cpan) = File::Basename::dirname($INC{"CPAN.pm"});
- my($configpmdir) = File::Spec->catdir($path_to_cpan,"CPAN");
- my($configpmtest) = File::Spec->catfile($configpmdir,"Config.pm");
- my $inc_key;
- if (-d $configpmdir or File::Path::mkpath($configpmdir)) {
- $configpm = _configpmtest($configpmdir,$configpmtest);
- $inc_key = "CPAN/Config.pm";
- }
- unless ($configpm) {
- $configpmdir = File::Spec->catdir(home,".cpan","CPAN");
- File::Path::mkpath($configpmdir);
- $configpmtest = File::Spec->catfile($configpmdir,"MyConfig.pm");
- $configpm = _configpmtest($configpmdir,$configpmtest);
- $inc_key = "CPAN/MyConfig.pm";
- }
- if ($configpm) {
- $INC{$inc_key} = $configpm;
- } else {
- my $text = qq{WARNING: CPAN.pm is unable to } .
- qq{create a configuration file.};
- output($text, 'confess');
- }
-
- }
- local($") = ", ";
- if ($redo && !$doit) {
- $CPAN::Frontend->myprint(<<END);
-Sorry, we have to rerun the configuration dialog for CPAN.pm due to
-some missing parameters...
-
-END
- $args{args} = \@miss;
- }
- CPAN::FirstTime::init($configpm, %args);
- $loading--;
- return;
-}
-
-
-# returns mandatory but missing entries in the Config
-sub missing_config_data {
- my(@miss);
- for (
- "auto_commit",
- "build_cache",
- "build_dir",
- "cache_metadata",
- "cpan_home",
- "ftp_proxy",
- #"gzip",
- "http_proxy",
- "index_expire",
- #"inhibit_startup_message",
- "keep_source_where",
- #"make",
- "make_arg",
- "make_install_arg",
- "makepl_arg",
- "mbuild_arg",
- "mbuild_install_arg",
- "mbuild_install_build_command",
- "mbuildpl_arg",
- "no_proxy",
- #"pager",
- "prerequisites_policy",
- "scan_cache",
- #"tar",
- #"unzip",
- "urllist",
- ) {
- next unless exists $keys{$_};
- push @miss, $_ unless defined $CPAN::Config->{$_};
- }
- return @miss;
-}
-
-sub help {
- $CPAN::Frontend->myprint(q[
-Known options:
- commit commit session changes to disk
- defaults reload default config values from disk
- help this help
- init enter a dialog to set all or a set of parameters
-
-Edit key values as in the following (the "o" is a literal letter o):
- o conf build_cache 15
- o conf build_dir "/foo/bar"
- o conf urllist shift
- o conf urllist unshift ftp://ftp.foo.bar/
- o conf inhibit_startup_message 1
-
-]);
- undef; #don't reprint CPAN::Config
-}
-
-sub cpl {
- my($word,$line,$pos) = @_;
- $word ||= "";
- CPAN->debug("word[$word] line[$line] pos[$pos]") if $CPAN::DEBUG;
- my(@words) = split " ", substr($line,0,$pos+1);
- if (
- defined($words[2])
- and
- $words[2] =~ /list$/
- and
- (
- @words == 3
- ||
- @words == 4 && length($word)
- )
- ) {
- return grep /^\Q$word\E/, qw(splice shift unshift pop push);
- } elsif (defined($words[2])
- and
- $words[2] eq "init"
- and
- (
- @words == 3
- ||
- @words >= 4 && length($word)
- )) {
- return sort grep /^\Q$word\E/, keys %keys;
- } elsif (@words >= 4) {
- return ();
- }
- my %seen;
- my(@o_conf) = sort grep { !$seen{$_}++ }
- keys %can,
- keys %$CPAN::Config,
- keys %keys;
- return grep /^\Q$word\E/, @o_conf;
-}
-
-sub prefs_lookup {
- my($self,$distro,$what) = @_;
-
- if ($prefssupport{$what}) {
- return $CPAN::Config->{$what} unless
- $distro
- and $distro->prefs
- and $distro->prefs->{cpanconfig}
- and defined $distro->prefs->{cpanconfig}{$what};
- return $distro->prefs->{cpanconfig}{$what};
- } else {
- $CPAN::Frontend->mywarn("Warning: $what not yet officially ".
- "supported for distroprefs, doing a normal lookup");
- return $CPAN::Config->{$what};
- }
-}
-
-
-{
- package
- CPAN::Config; ####::###### #hide from indexer
- # note: J. Nick Koston wrote me that they are using
- # CPAN::Config->commit although undocumented. I suggested
- # CPAN::Shell->o("conf","commit") even when ugly it is at least
- # documented
-
- # that's why I added the CPAN::Config class with autoload and
- # deprecated warning
-
- use strict;
- use vars qw($AUTOLOAD $VERSION);
- $VERSION = sprintf "%.2f", substr(q$Rev: 2212 $,4)/100;
-
- # formerly CPAN::HandleConfig was known as CPAN::Config
- sub AUTOLOAD {
- my $class = shift; # e.g. in dh-make-perl: CPAN::Config
- my($l) = $AUTOLOAD;
- $CPAN::Frontend->mywarn("Dispatching deprecated method '$l' to CPAN::HandleConfig\n");
- $l =~ s/.*:://;
- CPAN::HandleConfig->$l(@_);
- }
-}
-
-1;
-
-__END__
-
-=head1 LICENSE
-
-This program is free software; you can redistribute it and/or
-modify it under the same terms as Perl itself.
-
-=cut
-
-# Local Variables:
-# mode: cperl
-# cperl-indent-level: 4
-# End:
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/CPAN/Kwalify.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/CPAN/Kwalify.pm
deleted file mode 100644
index 77564cb7fc6..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/CPAN/Kwalify.pm
+++ /dev/null
@@ -1,130 +0,0 @@
-=head1 NAME
-
-CPAN::Kwalify - Interface between CPAN.pm and Kwalify.pm
-
-=head1 SYNOPSIS
-
- use CPAN::Kwalify;
- validate($schema_name, $data, $file, $doc);
-
-=head1 DESCRIPTION
-
-=over
-
-=item _validate($schema_name, $data, $file, $doc)
-
-$schema_name is the name of a supported schema. Currently only
-C<distroprefs> is supported. $data is the data to be validated. $file
-is the absolute path to the file the data are coming from. $doc is the
-index of the document within $doc that is to be validated. The last
-two arguments are only there for better error reporting.
-
-Relies on being called from within CPAN.pm.
-
-Dies if something fails. Does not return anything useful.
-
-=item yaml($schema_name)
-
-Returns the YAML text of that schema. Dies if something fails.
-
-=back
-
-=head1 AUTHOR
-
-Andreas Koenig C<< <andk@cpan.org> >>
-
-=head1 LICENSE
-
-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
-
-
-use strict;
-
-package CPAN::Kwalify;
-use vars qw($VERSION $VAR1);
-$VERSION = sprintf "%.6f", substr(q$Rev: 1418 $,4)/1000000 + 5.4;
-
-use File::Spec ();
-
-my %vcache = ();
-
-my $schema_loaded = {};
-
-sub _validate {
- my($schema_name,$data,$abs,$y) = @_;
- my $yaml_module = CPAN->_yaml_module;
- if (
- $CPAN::META->has_inst($yaml_module)
- &&
- $CPAN::META->has_inst("Kwalify")
- ) {
- my $load = UNIVERSAL::can($yaml_module,"Load");
- unless ($schema_loaded->{$schema_name}) {
- eval {
- my $schema_yaml = yaml($schema_name);
- $schema_loaded->{$schema_name} = $load->($schema_yaml);
- };
- if ($@) {
- # we know that YAML.pm 0.62 cannot parse the schema,
- # so we try a fallback
- my $content = do {
- my $path = __FILE__;
- $path =~ s/\.pm$//;
- $path = File::Spec->catfile($path, "$schema_name.dd");
- local *FH;
- open FH, $path or die "Could not open '$path': $!";
- local $/;
- <FH>;
- };
- $VAR1 = undef;
- eval $content;
- die "parsing of '$schema_name.dd' failed: $@" if $@;
- $schema_loaded->{$schema_name} = $VAR1;
- }
- }
- }
- if (my $schema = $schema_loaded->{$schema_name}) {
- my $mtime = (stat $abs)[9];
- for my $k (keys %{$vcache{$abs}}) {
- delete $vcache{$abs}{$k} unless $k eq $mtime;
- }
- return if $vcache{$abs}{$mtime}{$y}++;
- eval { Kwalify::validate($schema, $data) };
- if ($@) {
- die "validation of distropref '$abs'[$y] failed: $@";
- }
- }
-}
-
-sub _clear_cache {
- %vcache = ();
-}
-
-sub yaml {
- my($schema_name) = @_;
- my $content = do {
- my $path = __FILE__;
- $path =~ s/\.pm$//;
- $path = File::Spec->catfile($path, "$schema_name.yml");
- local *FH;
- open FH, $path or die "Could not open '$path': $!";
- local $/;
- <FH>;
- };
- return $content;
-}
-
-1;
-
-# Local Variables:
-# mode: cperl
-# cperl-indent-level: 4
-# End:
-
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/CPAN/Kwalify/distroprefs.dd b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/CPAN/Kwalify/distroprefs.dd
deleted file mode 100644
index 52118e5a98d..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/CPAN/Kwalify/distroprefs.dd
+++ /dev/null
@@ -1,137 +0,0 @@
-$VAR1 = {
- "mapping" => {
- "comment" => {
- "type" => "text"
- },
- "cpanconfig" => {
- "mapping" => {
- "=" => {
- "type" => "text"
- }
- },
- "type" => "map"
- },
- "depends" => {
- "mapping" => {
- "build_requires" => {
- "mapping" => {
- "=" => {
- "type" => "text"
- }
- },
- "type" => "map"
- },
- "configure_requires" => {},
- "requires" => {}
- },
- "type" => "map"
- },
- "disabled" => {
- "enum" => [
- 0,
- 1
- ],
- "type" => "int"
- },
- "goto" => {
- "type" => "text"
- },
- "install" => {
- "mapping" => {
- "args" => {
- "sequence" => [
- {
- "type" => "text"
- }
- ],
- "type" => "seq"
- },
- "commandline" => {
- "type" => "text"
- },
- "eexpect" => {
- "mapping" => {
- "mode" => {
- "enum" => [
- "deterministic",
- "anyorder"
- ],
- "type" => "text"
- },
- "reuse" => {
- "type" => "int"
- },
- "talk" => {
- "sequence" => [
- {
- "type" => "text"
- }
- ],
- "type" => "seq"
- },
- "timeout" => {
- "type" => "number"
- }
- },
- "type" => "map"
- },
- "env" => {
- "mapping" => {
- "=" => {
- "type" => "text"
- }
- },
- "type" => "map"
- },
- "expect" => {
- "sequence" => [
- {
- "type" => "text"
- }
- ],
- "type" => "seq"
- }
- },
- "type" => "map"
- },
- "make" => {},
- "match" => {
- "mapping" => {
- "distribution" => {
- "type" => "text"
- },
- "module" => {
- "type" => "text"
- },
- "perl" => {
- "type" => "text"
- },
- "perlconfig" => {
- "mapping" => {
- "=" => {
- "type" => "text"
- }
- },
- "type" => "map"
- }
- },
- "type" => "map"
- },
- "patches" => {
- "sequence" => [
- {
- "type" => "text"
- }
- ],
- "type" => "seq"
- },
- "pl" => {},
- "test" => {}
- },
- "type" => "map"
-};
-$VAR1->{"mapping"}{"depends"}{"mapping"}{"configure_requires"} = $VAR1->{"mapping"}{"depends"}{"mapping"}{"build_requires"};
-$VAR1->{"mapping"}{"depends"}{"mapping"}{"requires"} = $VAR1->{"mapping"}{"depends"}{"mapping"}{"build_requires"};
-$VAR1->{"mapping"}{"make"} = $VAR1->{"mapping"}{"install"};
-$VAR1->{"mapping"}{"pl"} = $VAR1->{"mapping"}{"install"};
-$VAR1->{"mapping"}{"test"} = $VAR1->{"mapping"}{"install"};
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/CPAN/Kwalify/distroprefs.yml b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/CPAN/Kwalify/distroprefs.yml
deleted file mode 100644
index 68ff72b5bef..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/CPAN/Kwalify/distroprefs.yml
+++ /dev/null
@@ -1,84 +0,0 @@
----
-type: map
-mapping:
- comment:
- type: text
- depends:
- type: map
- mapping:
- configure_requires:
- &requires_common
- type: map
- mapping:
- =:
- type: text
- build_requires: *requires_common
- requires: *requires_common
- match:
- type: map
- mapping:
- distribution:
- type: text
- module:
- type: text
- perl:
- type: text
- perlconfig:
- type: map
- mapping:
- =:
- type: text
- install:
- &args_env_expect
- type: map
- mapping:
- args:
- type: seq
- sequence:
- - type: text
- commandline:
- type: text
- env:
- type: map
- mapping:
- =:
- type: text
- expect:
- type: seq
- sequence:
- - type: text
- eexpect:
- type: map
- mapping:
- mode:
- type: text
- enum:
- - deterministic
- - anyorder
- timeout:
- type: number
- reuse:
- type: int
- talk:
- type: seq
- sequence:
- - type: text
- make: *args_env_expect
- pl: *args_env_expect
- test: *args_env_expect
- patches:
- type: seq
- sequence:
- - type: text
- disabled:
- type: int
- enum:
- - 0
- - 1
- goto:
- type: text
- cpanconfig:
- type: map
- mapping:
- =:
- type: text
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/CPAN/Nox.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/CPAN/Nox.pm
deleted file mode 100644
index d968f96d945..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/CPAN/Nox.pm
+++ /dev/null
@@ -1,51 +0,0 @@
-package CPAN::Nox;
-use strict;
-use vars qw($VERSION @EXPORT);
-
-BEGIN{
- $CPAN::Suppress_readline=1 unless defined $CPAN::term;
-}
-
-use base 'Exporter';
-use CPAN;
-
-$VERSION = sprintf "%.6f", substr(q$Rev: 2411 $,4)/1000000 + 5.4;
-$CPAN::META->has_inst('Digest::MD5','no');
-$CPAN::META->has_inst('LWP','no');
-$CPAN::META->has_inst('Compress::Zlib','no');
-@EXPORT = @CPAN::EXPORT;
-
-*AUTOLOAD = \&CPAN::AUTOLOAD;
-
-1;
-
-__END__
-
-=head1 NAME
-
-CPAN::Nox - Wrapper around CPAN.pm without using any XS module
-
-=head1 SYNOPSIS
-
-Interactive mode:
-
- perl -MCPAN::Nox -e shell;
-
-=head1 DESCRIPTION
-
-This package has the same functionality as CPAN.pm, but tries to
-prevent the usage of compiled extensions during its own
-execution. Its primary purpose is a rescue in case you upgraded perl
-and broke binary compatibility somehow.
-
-=head1 LICENSE
-
-This program is free software; you can redistribute it and/or
-modify it under the same terms as Perl itself.
-
-=head1 SEE ALSO
-
-L<CPAN>
-
-=cut
-
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/CPAN/Queue.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/CPAN/Queue.pm
deleted file mode 100644
index f01ab5133df..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/CPAN/Queue.pm
+++ /dev/null
@@ -1,193 +0,0 @@
-# -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*-
-use strict;
-package CPAN::Queue::Item;
-
-# CPAN::Queue::Item::new ;
-sub new {
- my($class,@attr) = @_;
- my $self = bless { @attr }, $class;
- return $self;
-}
-
-sub as_string {
- my($self) = @_;
- $self->{qmod};
-}
-
-# r => requires, b => build_requires, c => commandline
-sub reqtype {
- my($self) = @_;
- $self->{reqtype};
-}
-
-package CPAN::Queue;
-
-# One use of the queue is to determine if we should or shouldn't
-# announce the availability of a new CPAN module
-
-# Now we try to use it for dependency tracking. For that to happen
-# we need to draw a dependency tree and do the leaves first. This can
-# easily be reached by running CPAN.pm recursively, but we don't want
-# to waste memory and run into deep recursion. So what we can do is
-# this:
-
-# CPAN::Queue is the package where the queue is maintained. Dependencies
-# often have high priority and must be brought to the head of the queue,
-# possibly by jumping the queue if they are already there. My first code
-# attempt tried to be extremely correct. Whenever a module needed
-# immediate treatment, I either unshifted it to the front of the queue,
-# or, if it was already in the queue, I spliced and let it bypass the
-# others. This became a too correct model that made it impossible to put
-# an item more than once into the queue. Why would you need that? Well,
-# you need temporary duplicates as the manager of the queue is a loop
-# that
-#
-# (1) looks at the first item in the queue without shifting it off
-#
-# (2) cares for the item
-#
-# (3) removes the item from the queue, *even if its agenda failed and
-# even if the item isn't the first in the queue anymore* (that way
-# protecting against never ending queues)
-#
-# So if an item has prerequisites, the installation fails now, but we
-# want to retry later. That's easy if we have it twice in the queue.
-#
-# I also expect insane dependency situations where an item gets more
-# than two lives in the queue. Simplest example is triggered by 'install
-# Foo Foo Foo'. People make this kind of mistakes and I don't want to
-# get in the way. I wanted the queue manager to be a dumb servant, not
-# one that knows everything.
-#
-# Who would I tell in this model that the user wants to be asked before
-# processing? I can't attach that information to the module object,
-# because not modules are installed but distributions. So I'd have to
-# tell the distribution object that it should ask the user before
-# processing. Where would the question be triggered then? Most probably
-# in CPAN::Distribution::rematein.
-
-use vars qw{ @All $VERSION };
-$VERSION = sprintf "%.6f", substr(q$Rev: 2212 $,4)/1000000 + 5.4;
-
-# CPAN::Queue::queue_item ;
-sub queue_item {
- my($class,@attr) = @_;
- my $item = "$class\::Item"->new(@attr);
- $class->qpush($item);
- return 1;
-}
-
-# CPAN::Queue::qpush ;
-sub qpush {
- my($class,$obj) = @_;
- push @All, $obj;
- CPAN->debug(sprintf("in new All[%s]",
- join("",map {sprintf " %s\[%s]\n",$_->{qmod},$_->{reqtype}} @All),
- )) if $CPAN::DEBUG;
-}
-
-# CPAN::Queue::first ;
-sub first {
- my $obj = $All[0];
- $obj;
-}
-
-# CPAN::Queue::delete_first ;
-sub delete_first {
- my($class,$what) = @_;
- my $i;
- for my $i (0..$#All) {
- if ( $All[$i]->{qmod} eq $what ) {
- splice @All, $i, 1;
- return;
- }
- }
-}
-
-# CPAN::Queue::jumpqueue ;
-sub jumpqueue {
- my $class = shift;
- my @what = @_;
- CPAN->debug(sprintf("before jumpqueue All[%s] what[%s]",
- join("",
- map {sprintf " %s\[%s]\n",$_->{qmod},$_->{reqtype}} @All, @what
- ))) if $CPAN::DEBUG;
- unless (defined $what[0]{reqtype}) {
- # apparently it was not the Shell that sent us this enquiry,
- # treat it as commandline
- $what[0]{reqtype} = "c";
- }
- my $inherit_reqtype = $what[0]{reqtype} =~ /^(c|r)$/ ? "r" : "b";
- WHAT: for my $what_tuple (@what) {
- my($what,$reqtype) = @$what_tuple{qw(qmod reqtype)};
- if ($reqtype eq "r"
- &&
- $inherit_reqtype eq "b"
- ) {
- $reqtype = "b";
- }
- my $jumped = 0;
- for (my $i=0; $i<$#All;$i++) { #prevent deep recursion
- # CPAN->debug("i[$i]this[$All[$i]{qmod}]what[$what]") if $CPAN::DEBUG;
- if ($All[$i]{qmod} eq $what) {
- $jumped++;
- if ($jumped >= 50) {
- die "PANIC: object[$what] 50 instances on the queue, looks like ".
- "some recursiveness has hit";
- } elsif ($jumped > 25) { # one's OK if e.g. just processing
- # now; more are OK if user typed
- # it several times
- my $sleep = sprintf "%.1f", $jumped/10;
- $CPAN::Frontend->mywarn(
-qq{Warning: Object [$what] queued $jumped times, sleeping $sleep secs!\n}
- );
- $CPAN::Frontend->mysleep($sleep);
- # next WHAT;
- }
- }
- }
- my $obj = "$class\::Item"->new(
- qmod => $what,
- reqtype => $reqtype
- );
- unshift @All, $obj;
- }
- CPAN->debug(sprintf("after jumpqueue All[%s]",
- join("",map {sprintf " %s\[%s]\n",$_->{qmod},$_->{reqtype}} @All)
- )) if $CPAN::DEBUG;
-}
-
-# CPAN::Queue::exists ;
-sub exists {
- my($self,$what) = @_;
- my @all = map { $_->{qmod} } @All;
- my $exists = grep { $_->{qmod} eq $what } @All;
- # warn "in exists what[$what] all[@all] exists[$exists]";
- $exists;
-}
-
-# CPAN::Queue::delete ;
-sub delete {
- my($self,$mod) = @_;
- @All = grep { $_->{qmod} ne $mod } @All;
- CPAN->debug(sprintf("after delete mod[%s] All[%s]",
- $mod,
- join("",map {sprintf " %s\[%s]\n",$_->{qmod},$_->{reqtype}} @All)
- )) if $CPAN::DEBUG;
-}
-
-# CPAN::Queue::nullify_queue ;
-sub nullify_queue {
- @All = ();
-}
-
-1;
-
-__END__
-
-=head1 LICENSE
-
-This program is free software; you can redistribute it and/or
-modify it under the same terms as Perl itself.
-
-=cut
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/CPAN/Reporter.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/CPAN/Reporter.pm
deleted file mode 100644
index 6a217071480..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/CPAN/Reporter.pm
+++ /dev/null
@@ -1,1487 +0,0 @@
-package CPAN::Reporter;
-use strict;
-use vars qw/$VERSION/;
-$VERSION = '1.13';
-$VERSION = eval $VERSION;
-
-use Config;
-use CPAN ();
-use CPAN::Version ();
-use File::Basename qw/basename/;
-use File::Find ();
-use File::HomeDir ();
-use File::Path qw/mkpath rmtree/;
-use File::Spec ();
-use IO::File ();
-use Probe::Perl ();
-use Tee qw/tee/;
-use Test::Reporter ();
-use CPAN::Reporter::Config ();
-use CPAN::Reporter::History ();
-use CPAN::Reporter::PrereqCheck ();
-
-use constant MAX_OUTPUT_LENGTH => 50_000;
-
-#--------------------------------------------------------------------------#
-# public API
-#--------------------------------------------------------------------------#
-
-sub configure {
- goto &CPAN::Reporter::Config::_configure;
-}
-
-sub grade_make {
- my @args = @_;
- my $result = _init_result( 'make', @args ) or return;
- _compute_make_grade($result);
- if ( $result->{grade} eq 'discard' ) {
- $CPAN::Frontend->myprint(
- "\nCPAN::Reporter: test results were not valid, $result->{grade_msg}.\n\n",
- $result->{prereq_pm}, "\n",
- "Test report will not be sent"
- );
- CPAN::Reporter::History::_record_history( $result )
- if not CPAN::Reporter::History::_is_duplicate( $result );
- }
- else {
- _print_grade_msg($result->{make_cmd}, $result);
- if ( $result->{grade} ne 'pass' ) { _dispatch_report( $result ) }
- }
- return $result->{success};
-}
-
-sub grade_PL {
- my @args = @_;
- my $result = _init_result( 'PL', @args ) or return;
- _compute_PL_grade($result);
- if ( $result->{grade} eq 'discard' ) {
- $CPAN::Frontend->myprint(
- "\nCPAN::Reporter: test results were not valid, $result->{grade_msg}.\n\n",
- $result->{prereq_pm}, "\n",
- "Test report will not be sent"
- );
- CPAN::Reporter::History::_record_history( $result )
- if not CPAN::Reporter::History::_is_duplicate( $result );
- }
- else {
- _print_grade_msg($result->{PL_file} , $result);
- if ( $result->{grade} ne 'pass' ) { _dispatch_report( $result ) }
- }
- return $result->{success};
-}
-
-sub grade_test {
- my @args = @_;
- my $result = _init_result( 'test', @args ) or return;
- _compute_test_grade($result);
- if ( $result->{grade} eq 'discard' ) {
- $CPAN::Frontend->myprint(
- "\nCPAN::Reporter: test results were not valid, $result->{grade_msg}.\n\n",
- $result->{prereq_pm}, "\n",
- "Test report will not be sent"
- );
- CPAN::Reporter::History::_record_history( $result )
- if not CPAN::Reporter::History::_is_duplicate( $result );
- }
- else {
- _print_grade_msg( "Test", $result );
- _dispatch_report( $result );
- }
- return $result->{success};
-}
-
-sub record_command {
- my ($command, $timeout) = @_;
-
- # XXX refactor this!
- # Get configuration options
- if ( -r CPAN::Reporter::Config::_get_config_file() ) {
- my $config_obj = CPAN::Reporter::Config::_open_config_file();
- my $config;
- $config = CPAN::Reporter::Config::_get_config_options( $config_obj )
- if $config_obj;
-
- $timeout ||= $config->{command_timeout}; # might still be undef
- }
-
- my ($cmd, $redirect) = _split_redirect($command);
-
- my $temp_out = _temp_filename( 'CPAN-Reporter-TO-' );
-
- # Teeing a command loses its exit value so we must wrap the command
- # and print the exit code so we can read it off of output
- my $wrap_code;
- if ( $timeout ) {
- $wrap_code = $^O eq 'MSWin32'
- ? _timeout_wrapper_win32($cmd, $timeout)
- : _timeout_wrapper($cmd, $timeout);
- }
- # if no timeout or timeout wrap code wasn't available
- if ( ! $wrap_code ) {
- my $safecmd = quotemeta($cmd);
- $wrap_code = << "HERE";
-my \$rc = system("$safecmd");
-my \$ec = \$rc == -1 ? -1 : \$?;
-print "($safecmd exited with \$ec)\\n";
-HERE
- }
-
- # write code to a tempfile for execution
- my $wrapper_name = _temp_filename( 'CPAN-Reporter-CW-' );
- my $wrapper_fh = IO::File->new( $wrapper_name, 'w' )
- or die "Could not create a wrapper for $cmd\: $!";
-
- $wrapper_fh->print( $wrap_code );
- $wrapper_fh->close;
-
- # tee the command wrapper
- my $tee_input = Probe::Perl->find_perl_interpreter() . " $wrapper_name";
- $tee_input .= " $redirect" if defined $redirect;
- tee($tee_input, { stderr => 1 }, $temp_out);
-
- # read back the output
- my $output_fh = IO::File->new($temp_out, "r");
- if ( !$output_fh ) {
- $CPAN::Frontend->mywarn(
- "CPAN::Reporter: couldn't read command results for '$cmd'\n"
- );
- return;
- }
- my @cmd_output = <$output_fh>;
- $output_fh->close;
-
- # cleanup
- unlink $wrapper_name, $temp_out;
-
- if ( ! @cmd_output ) {
- $CPAN::Frontend->mywarn(
- "CPAN::Reporter: didn't capture command results for '$cmd'\n"
- );
- return;
- }
-
- # extract the exit value
- my $exit_value;
- if ( $cmd_output[-1] =~ m{exited with} ) {
- ($exit_value) = $cmd_output[-1] =~ m{exited with ([-0-9]+)};
- pop @cmd_output;
- }
-
- # bail out on some errors
- if ( ! defined $exit_value ) {
- $CPAN::Frontend->mywarn(
- "CPAN::Reporter: couldn't determine exit value for '$cmd'\n"
- );
- return;
- }
- elsif ( $exit_value == -1 ) {
- $CPAN::Frontend->mywarn(
- "CPAN::Reporter: couldn't execute '$cmd'\n"
- );
- return;
- }
-
- return \@cmd_output, $exit_value;
-}
-
-sub test {
- my ($dist, $system_command) = @_;
- my ($output, $exit_value) = record_command( $system_command );
- return grade_test( $dist, $system_command, $output, $exit_value );
-}
-
-#--------------------------------------------------------------------------#
-# private functions
-#--------------------------------------------------------------------------#
-
-#--------------------------------------------------------------------------#
-# _compute_make_grade
-#--------------------------------------------------------------------------#
-
-sub _compute_make_grade {
- my $result = shift;
- my ($grade,$msg);
- if ( $result->{exit_value} ) {
- $result->{grade} = "fail";
- $result->{grade_msg} = "Stopped with an error"
- }
- else {
- $result->{grade} = "pass";
- $result->{grade_msg} = "No errors"
- }
-
- _downgrade_known_causes( $result );
-
- $result->{success} = $result->{grade} eq 'pass'
- || $result->{grade} eq 'unknown';
- return;
-}
-
-#--------------------------------------------------------------------------#
-# _compute_PL_grade
-#--------------------------------------------------------------------------#
-
-sub _compute_PL_grade {
- my $result = shift;
- my ($grade,$msg);
- if ( $result->{exit_value} ) {
- $result->{grade} = "fail";
- $result->{grade_msg} = "Stopped with an error"
- }
- else {
- $result->{grade} = "pass";
- $result->{grade_msg} = "No errors"
- }
-
- _downgrade_known_causes( $result );
-
- $result->{success} = $result->{grade} eq 'pass'
- || $result->{grade} eq 'unknown';
- return;
-}
-
-#--------------------------------------------------------------------------#
-# _compute_test_grade
-#
-# Don't shortcut to unknown unless _has_tests because a custom
-# Makefile.PL or Build.PL might define tests in a non-standard way
-#
-# With test.pl and 'make test', any t/*.t might pass Test::Harness, but
-# test.pl might still fail, or there might only be test.pl,
-# so use exit code directly
-#
-# Likewise, if we have recursive Makefile.PL, then we don't trust the
-# reverse-order parsing and should just take the exit code directly
-#
-# Otherwise, parse in reverse order for Test::Harness output or a couple
-# other significant strings and stop after the first match. Going in
-# reverse and stopping is done to (hopefully) avoid picking up spurious
-# results from any test output. But then we have to check for
-# unsupported OS strings in case those were printed but were not fatal.
-#--------------------------------------------------------------------------#
-
-sub _compute_test_grade {
- my $result = shift;
- my ($grade,$msg);
- my $output = $result->{output};
-
- # In some cases, get a result straight from the exit code
- if ( $result->{is_make} && ( -f "test.pl" || _has_recursive_make() ) ) {
- if ( $result->{exit_value} ) {
- $grade = "fail";
- $msg = "'make test' error detected";
- }
- else {
- $grade = "pass";
- $msg = "'make test' no errors";
- }
- }
- # Otherwise, get a result from Test::Harness output
- else {
- # figure out the right harness parser
- _expand_result( $result );
- my $harness_version = $result->{toolchain}{'Test::Harness'}{have};
- my $harness_parser = CPAN::Version->vgt($harness_version, '2.99_01')
- ? \&_parse_tap_harness
- : \&_parse_test_harness;
- # parse lines in reverse
- for my $i ( reverse 0 .. $#{$output} ) {
- if ( $output->[$i] =~ m{No support for OS|OS unsupported}ims ) { # from any *.t file
- $grade = 'na';
- $msg = 'This platform is not supported';
- }
- elsif ( $output->[$i] =~ m{^.?No tests defined}ms ) { # from M::B
- $grade = 'unknown';
- $msg = 'No tests provided';
- }
- else {
- ($grade, $msg) = $harness_parser->( $output->[$i] );
- }
- last if $grade;
- }
- # fallback on exit value if no recognizable Test::Harness output
- if ( ! $grade ) {
- $grade = $result->{exit_value} ? "fail" : "pass";
- $msg = ( $result->{is_make} ? "'make test' " : "'Build test' " )
- . ( $result->{exit_value} ? "error detected" : "no errors");
- }
- }
-
- $result->{grade} = $grade;
- $result->{grade_msg} = $msg;
-
- _downgrade_known_causes( $result );
-
- $result->{success} = $result->{grade} eq 'pass'
- || $result->{grade} eq 'unknown';
- return;
-}
-
-#--------------------------------------------------------------------------#
-# _dispatch_report
-#
-# Set up Test::Reporter and prompt user for CC, edit, send
-#--------------------------------------------------------------------------#
-
-sub _dispatch_report {
- my $result = shift;
- my $phase = $result->{phase};
-
- $CPAN::Frontend->myprint(
- "CPAN::Reporter: preparing a CPAN Testers report for $result->{dist_name}\n"
- );
-
- # Get configuration options
- my $config_obj = CPAN::Reporter::Config::_open_config_file();
- my $config;
- $config = CPAN::Reporter::Config::_get_config_options( $config_obj )
- if $config_obj;
- if ( ! $config->{email_from} ) {
- $CPAN::Frontend->mywarn( << "EMAIL_REQUIRED");
-
-CPAN::Reporter: required 'email_from' option missing an email address, so
-test report will not be sent. See documentation for configuration details.
-
-EMAIL_REQUIRED
- return;
- }
-
- # Abort if the distribution name is not formatted according to
- # CPAN Testers requirements: Dist-Name-version.suffix
- # Regex from CPAN-Testers should extract name, separator, version
- # and extension
- my @format_checks = $result->{dist_basename} =~
- m{(.+)([\-\_])(v?\d.*)(\.(?:tar\.(?:gz|bz2)|tgz|zip))$}i;
- ;
- if ( ! grep { length } @format_checks ) {
- $CPAN::Frontend->mywarn( << "END_BAD_DISTNAME");
-
-CPAN::Reporter: the distribution name '$result->{dist_basename}' does not
-appear to be packaged according to CPAN tester guidelines. Perhaps it is
-not a normal CPAN distribution.
-
-Test report will not be sent.
-
-END_BAD_DISTNAME
-
- return;
- }
-
- # Gather 'expensive' data for the report
- _expand_result( $result);
-
- # Skip if distribution name matches the send_skipfile
- if ( $config->{send_skipfile} && -r $config->{send_skipfile} ) {
- my $send_skipfile = IO::File->new( $config->{send_skipfile}, "r" );
- my $dist_id = $result->{dist}->pretty_id;
- while ( my $pattern = <$send_skipfile> ) {
- chomp($pattern);
- # ignore comments
- next if substr($pattern,0,1) eq '#';
- # if it doesn't match, continue with next pattern
- next if $dist_id !~ /$pattern/i;
- # if it matches, warn and return
- $CPAN::Frontend->myprint( << "END_SKIP_DIST" );
-CPAN::Reporter: '$dist_id' matched against the send_skipfile.
-
-Test report will not be sent.
-
-END_SKIP_DIST
-
- return;
- }
- }
-
- # Setup the test report
- my $tr = Test::Reporter->new;
- $tr->grade( $result->{grade} );
- $tr->distribution( $result->{dist_name} );
-
- # Skip if duplicate and not sending duplicates
- my $is_duplicate = CPAN::Reporter::History::_is_duplicate( $result );
- if ( $is_duplicate ) {
- if ( _prompt( $config, "send_duplicates", $tr->grade) =~ /^n/ ) {
- $CPAN::Frontend->myprint(<< "DUPLICATE_REPORT");
-
-CPAN::Reporter: this appears to be a duplicate report for the $phase phase:
-@{[$tr->subject]}
-
-Test report will not be sent.
-
-DUPLICATE_REPORT
-
- return;
- }
- }
-
- # Set debug and transport options, if supported
- $tr->debug( $config->{debug} ) if defined $config->{debug};
- my $transport = $config->{transport} || 'Net::SMTP';
- if (length $transport && ( $transport !~ /\ANet::SMTP|Mail::Send\z/ )) {
- $CPAN::Frontend->mywarn(
- "CPAN::Reporter: '$config->{transport}' is not a valid transport option." .
- " Falling back to Net::SMTP\n"
- );
- $transport = 'Net::SMTP';
- }
- $tr->transport( $transport );
-
- # prepare mail transport
- $tr->from( $config->{email_from} );
- $tr->address( $config->{email_to} ) if $config->{email_to};
- if ( $config->{smtp_server} ) {
- my @mx = split " ", $config->{smtp_server};
- $tr->mx( \@mx );
- }
-
- # Populate the test report
- $tr->comments( _report_text( $result ) );
- $tr->via( 'CPAN::Reporter ' . $CPAN::Reporter::VERSION );
- my @cc = _should_copy_author( $result, $config );
-
- # prompt for editing report
- if ( _prompt( $config, "edit_report", $tr->grade ) =~ /^y/ ) {
- my $editor = $config->{editor};
- local $ENV{VISUAL} = $editor if $editor; ## no critic
- $tr->edit_comments;
- }
-
- # send_*_report can override send_report
- my $send_config = defined $config->{"send_$phase\_report"}
- ? "send_$phase\_report"
- : "send_report" ;
- if ( _prompt( $config, $send_config, $tr->grade ) =~ /^y/ ) {
- $CPAN::Frontend->myprint( "CPAN::Reporter: sending test report with '" . $tr->grade .
- "' to " . join(q{, }, $tr->address, @cc) . "\n");
- if ( $tr->send( @cc ) ) {
- CPAN::Reporter::History::_record_history( $result )
- if not $is_duplicate;
- }
- else {
- $CPAN::Frontend->mywarn( "CPAN::Reporter: " . $tr->errstr . "\n");
- }
- }
- else {
- $CPAN::Frontend->myprint("CPAN::Reporter: test report will not be sent\n");
- }
-
- return;
-}
-
-#--------------------------------------------------------------------------#
-# _downgrade_known_causes
-# Downgrade failure/unknown grade if we can determine a cause
-# If platform not supported => 'na'
-# If perl version is too low => 'na'
-# If stated prereqs missing => 'discard'
-#--------------------------------------------------------------------------#
-
-sub _downgrade_known_causes {
- my ($result) = @_;
- my ($grade, $output) = ( $result->{grade}, $result->{output} );
- my $msg = $result->{grade_msg} || q{};
-
- # shortcut unless fail/unknown; but PL might look like pass but actually
- # have "OS Unsupported" messages if someone printed message and then
- # did "exit 0"
- return if $grade eq 'na';
- return if $grade eq 'pass' && $result->{phase} ne 'PL';
-
- # get prereqs
- _expand_result( $result );
-
- # if process was halted with a signal, just set for discard and return
- if ( $result->{exit_value} & 127 ) {
- $result->{grade} = 'discard';
- $result->{grade_msg} = 'Command interrupted';
- return;
- }
-
- # look for perl version error messages from various programs
- # "Error evaling..." type errors happen on Perl < 5.006 when modules
- # define their version with "our $VERSION = ..."
- my $version_error;
- for my $line ( @$output ) {
- if( $line =~ /Perl .*? required.*?--this is only/ims ||
- $line =~ /ERROR: perl: Version .*? is installed, but we need version/ims ||
- $line =~ /ERROR: perl \(.*?\) is installed, but we need version/ims ||
- $line =~ /Error evaling version line 'BEGIN/ims ||
- $line =~ /Could not eval '/ims
- ) {
- $version_error++;
- last;
- }
- }
-
- # check for explicit version error or just a perl version prerequisite
- if ( $version_error || $result->{prereq_pm} =~ m{^\s+!\s+perl\s}ims ) {
- $grade = 'na';
- $msg = 'Perl version too low';
- }
- # check again for unsupported OS in case we took 'fail' from exit value
- elsif ( grep { /No support for OS|OS unsupported/ims } @{$output} ) {
- $grade = 'na';
- $msg = 'This platform is not supported';
- }
- # check the prereq report for missing or failure flag '!'
- elsif ( $grade ne 'pass' && $result->{prereq_pm} =~ m{n/a}ims ) {
- $grade = 'discard';
- $msg = 'Prerequisite missing';
- }
- elsif ( $grade ne 'pass' && $result->{prereq_pm} =~ m{^\s+!}ims ) {
- $grade = 'discard';
- $msg = 'Prerequisite version too low';
- }
- # in PL stage -- if pass but no Makefile or Build, then this should
- # be recorded as a discard
- elsif ( $result->{phase} eq 'PL' && $grade eq 'pass'
- && ! -f 'Makefile' && ! -f 'Build'
- ) {
- $grade = 'discard';
- $msg = 'No Makefile or Build file found';
- }
-
- # store results
- $result->{grade} = $grade;
- $result->{grade_msg} = $msg;
-
- return;
-}
-
-#--------------------------------------------------------------------------#
-# _expand_result - add expensive information like prerequisites and
-# toolchain that should only be generated if a report will actually
-# be sent
-#--------------------------------------------------------------------------#
-
-sub _expand_result {
- my $result = shift;
- return if $result->{expanded}++; # only do this once
- $result->{prereq_pm} = _prereq_report( $result->{dist} );
- $result->{env_vars} = _env_report();
- $result->{special_vars} = _special_vars_report();
- $result->{toolchain_versions} = _toolchain_report( $result );
- $result->{perl_version} = CPAN::Reporter::History::_format_perl_version();
- return;
-}
-
-#--------------------------------------------------------------------------#
-# _env_report
-#--------------------------------------------------------------------------#
-
-# Entries bracketed with "/" are taken to be a regex; otherwise literal
-my @env_vars= qw(
- /PERL/
- /LC_/
- LANG
- LANGUAGE
- PATH
- SHELL
- COMSPEC
- TERM
- TEMP
- TMPDIR
- AUTOMATED_TESTING
- /AUTHOR_TEST/
- INCLUDE
- LIB
- LD_LIBRARY_PATH
- PROCESSOR_IDENTIFIER
- NUMBER_OF_PROCESSORS
-);
-
-sub _env_report {
- my @vars_found;
- for my $var ( @env_vars ) {
- if ( $var =~ m{^/(.+)/$} ) {
- push @vars_found, grep { /$1/ } keys %ENV;
- }
- else {
- push @vars_found, $var if exists $ENV{$var};
- }
- }
-
- my $report = "";
- for my $var ( sort @vars_found ) {
- my $value = $ENV{$var};
- $value = '[undef]' if ! defined $value;
- $report .= " $var = $value\n";
- }
- return $report;
-}
-
-#--------------------------------------------------------------------------#
-# _has_recursive_make
-#
-# Ignore Makefile.PL in t directories
-#--------------------------------------------------------------------------#
-
-sub _has_recursive_make {
- my $PL_count = 0;
- File::Find::find(
- sub {
- if ( $_ eq 't' ) {
- $File::Find::prune = 1;
- }
- elsif ( $_ eq 'Makefile.PL' ) {
- $PL_count++;
- }
- },
- File::Spec->curdir()
- );
- return $PL_count > 1;
-}
-
-#--------------------------------------------------------------------------#
-# _init_result -- create and return a hash of values for use in
-# report evaluation and dispatch
-#
-# takes same argument format as grade_*()
-#--------------------------------------------------------------------------#
-
-sub _init_result {
- my ($phase, $dist, $system_command, $output, $exit_value) = @_;
-
- unless ( defined $output && defined $exit_value ) {
- my $missing;
- if ( ! defined $output && ! defined $exit_value ) {
- $missing = "exit value and output"
- }
- elsif ( defined $output && !defined $exit_value ) {
- $missing = "exit value"
- }
- else {
- $missing = "output";
- }
- $CPAN::Frontend->mywarn(
- "CPAN::Reporter: had errors capturing $missing. Tests abandoned"
- );
- return;
- }
-
- my $result = {
- phase => $phase,
- dist => $dist,
- command => $system_command,
- is_make => _is_make( $system_command ),
- output => ref $output eq 'ARRAY' ? $output : [ split /\n/, $output ],
- exit_value => $exit_value,
- # Note: pretty_id is like "DAGOLDEN/CPAN-Reporter-0.40.tar.gz"
- dist_basename => basename($dist->pretty_id),
- dist_name => $dist->base_id,
- };
-
- # Used in messages to user
- $result->{PL_file} = $result->{is_make} ? "Makefile.PL" : "Build.PL";
- $result->{make_cmd} = $result->{is_make} ? $Config{make} : "Build";
-
- # CPAN might fail to find an author object for some strange dists
- my $author = $dist->author;
- $result->{author} = defined $author ? $author->fullname : "Author";
- $result->{author_id} = defined $author ? $author->id : "" ;
-
- return $result;
-}
-
-#--------------------------------------------------------------------------#
-# _is_make
-#--------------------------------------------------------------------------#
-
-sub _is_make {
- my $command = shift;
- return $command =~ m{\b(?:\S*make|Makefile.PL)\b}ims ? 1 : 0;
-}
-
-#--------------------------------------------------------------------------#
-# _max_length
-#--------------------------------------------------------------------------#
-
-sub _max_length {
- my ($first, @rest) = @_;
- my $max = length $first;
- for my $term ( @rest ) {
- $max = length $term if length $term > $max;
- }
- return $max;
-}
-
-
-#--------------------------------------------------------------------------#
-# _parse_tap_harness
-#
-# As of Test::Harness 2.99_02, the final line is provided by TAP::Harness
-# as "Result: STATUS" where STATUS is "PASS", "FAIL" or "NOTESTS"
-#--------------------------------------------------------------------------#
-
-
-sub _parse_tap_harness {
- my ($line) = @_;
- if ( $line =~ m{^Result:\s+([A-Z]+)} ) {
- if ( $1 eq 'PASS' ) {
- return ('pass', 'All tests successful');
- }
- elsif ( $1 eq 'FAIL' ) {
- return ('fail', 'One or more tests failed');
- }
- elsif ( $1 eq 'NOTESTS' ) {
- return ('unknown', 'No tests were run');
- }
- }
- elsif ( $line =~ m{Bailout called\.\s+Further testing stopped}ms ) {
- return ( 'fail', 'Bailed out of tests');
- }
- return;
-}
-
-#--------------------------------------------------------------------------#
-# _parse_test_harness
-#
-# Output strings taken from Test::Harness::
-# _show_results() -- for versions < 2.57_03
-# get_results() -- for versions >= 2.57_03
-#--------------------------------------------------------------------------#
-
-sub _parse_test_harness {
- my ($line) = @_;
- if ( $line =~ m{^All tests successful}ms ) {
- return ( 'pass', 'All tests successful' );
- }
- elsif ( $line =~ m{^FAILED--no tests were run}ms ) {
- return ( 'unknown', 'No tests were run' );
- }
- elsif ( $line =~ m{^FAILED--.*--no output}ms ) {
- return ( 'unknown', 'No tests were run');
- }
- elsif ( $line =~ m{FAILED--Further testing stopped}ms ) {
- return ( 'fail', 'Bailed out of tests');
- }
- elsif ( $line =~ m{^Failed }ms ) { # must be lowercase
- return ( 'fail', 'One or more tests failed');
- }
- else {
- return;
- }
-}
-
-#--------------------------------------------------------------------------#
-# _prereq_report
-#--------------------------------------------------------------------------#
-
-sub _prereq_report {
- my $dist = shift;
- my (%need, %have, %prereq_met, $report);
-
- my $prereq_pm = $dist->prereq_pm;
-
- if ( ref $prereq_pm eq 'HASH' ) {
- # is it the new CPAN style with requires/build_requires?
- if (join(q{ }, sort keys %$prereq_pm) eq "build_requires requires") {
- $need{requires} = $prereq_pm->{requires}
- if ref $prereq_pm->{requires} eq 'HASH';
- $need{build_requires} = $prereq_pm->{build_requires}
- if ref $prereq_pm->{build_requires} eq 'HASH';
- }
- else {
- $need{requires} = $prereq_pm;
- }
- }
-
- # see what prereqs are satisfied in subprocess
- for my $section ( qw/requires build_requires/ ) {
- next unless ref $need{$section} eq 'HASH';
- my @prereq_list = %{ $need{$section} };
- next unless @prereq_list;
- my $prereq_results = _version_finder( @prereq_list );
- for my $mod ( keys %{$prereq_results} ) {
- $have{$section}{$mod} = $prereq_results->{$mod}{have};
- $prereq_met{$section}{$mod} = $prereq_results->{$mod}{met};
- }
- }
-
- # find formatting widths
- my ($name_width, $need_width, $have_width) = (6, 4, 4);
- for my $section ( qw/requires build_requires/ ) {
- for my $module ( keys %{ $need{$section} } ) {
- my $name_length = length $module;
- my $need_length = length $need{$section}{$module};
- my $have_length = length $have{$section}{$module};
- $name_width = $name_length if $name_length > $name_width;
- $need_width = $need_length if $need_length > $need_width;
- $have_width = $have_length if $have_length > $have_width;
- }
- }
-
- my $format_str =
- " \%1s \%-${name_width}s \%-${need_width}s \%-${have_width}s\n";
-
- # generate the report
- for my $section ( qw/requires build_requires/ ) {
- if ( keys %{ $need{$section} } ) {
- $report .= "$section:\n\n";
- $report .= sprintf( $format_str, " ", qw/Module Need Have/ );
- $report .= sprintf( $format_str, " ",
- "-" x $name_width,
- "-" x $need_width,
- "-" x $have_width );
- }
- for my $module ( sort { lc $a cmp lc $b } keys %{ $need{$section} } ) {
- my $need = $need{$section}{$module};
- my $have = $have{$section}{$module};
- my $bad = $prereq_met{$section}{$module} ? " " : "!";
- $report .=
- sprintf( $format_str, $bad, $module, $need, $have);
- }
- }
-
- return $report || " No requirements found\n";
-}
-
-#--------------------------------------------------------------------------#
-# _print_grade_msg -
-#--------------------------------------------------------------------------#
-
-sub _print_grade_msg {
- my ($phase, $result) = @_;
- my ($grade, $msg) = ($result->{grade}, $result->{grade_msg});
- $CPAN::Frontend->myprint( "CPAN::Reporter: $phase result is '$grade'");
- $CPAN::Frontend->myprint(", $msg") if defined $msg && length $msg;
- $CPAN::Frontend->myprint(".\n");
- return;
-}
-
-#--------------------------------------------------------------------------#
-# _prompt
-#
-# Note: always returns lowercase
-#--------------------------------------------------------------------------#
-
-sub _prompt {
- my ($config, $option, $grade, $extra) = @_;
- $extra ||= q{};
-
- my %spec = CPAN::Reporter::Config::_config_spec();
-
- my $dispatch = CPAN::Reporter::Config::_validate_grade_action_pair(
- $option, join(q{ }, "default:no", $config->{$option} || '')
- );
- my $action = $dispatch->{$grade} || $dispatch->{default};
- my $intro = $spec{$option}{prompt} . $extra . " (yes/no)";
- my $prompt;
- if ( $action =~ m{^ask/yes}i ) {
- $prompt = CPAN::Shell::colorable_makemaker_prompt( $intro, "yes" );
- }
- elsif ( $action =~ m{^ask(/no)?}i ) {
- $prompt = CPAN::Shell::colorable_makemaker_prompt( $intro, "no" );
- }
- else {
- $prompt = $action;
- }
- return lc $prompt;
-}
-
-#--------------------------------------------------------------------------#
-# _report_text
-#--------------------------------------------------------------------------#
-
-my %intro_para = (
- 'pass' => <<'HERE',
-Thank you for uploading your work to CPAN. Congratulations!
-All tests were successful.
-HERE
-
- 'fail' => <<'HERE',
-Thank you for uploading your work to CPAN. However, there was a problem
-testing your distribution.
-
-If you think this report is invalid, please consult the CPAN Testers Wiki
-for suggestions on how to avoid getting FAIL reports for missing library
-or binary dependencies, unsupported operating systems, and so on:
-
-http://cpantest.grango.org/wiki/CPANAuthorNotes
-HERE
-
- 'unknown' => <<'HERE',
-Thank you for uploading your work to CPAN. However, attempting to
-test your distribution gave an inconclusive result.
-
-This could be because you did not define tests, tests could not be
-found, because your tests were interrupted before they finished, or
-because the results of the tests could not be parsed. You may wish to
-consult the CPAN Testers Wiki:
-
-http://cpantest.grango.org/wiki/CPANAuthorNotes
-HERE
-
- 'na' => <<'HERE',
-Thank you for uploading your work to CPAN. While attempting to build or test
-this distribution, the distribution signaled that support is not available
-either for this operating system or this version of Perl. Nevertheless, any
-diagnostic output produced is provided below for reference. If this is not
-what you expect, you may wish to consult the CPAN Testers Wiki:
-
-http://cpantest.grango.org/wiki/CPANAuthorNotes
-HERE
-
-);
-
-sub _report_text {
- my $data = shift;
- my $test_log = join(q{},@{$data->{output}});
- if ( length $test_log > MAX_OUTPUT_LENGTH ) {
- $test_log = substr( $test_log, 0, MAX_OUTPUT_LENGTH) . "\n";
- my $max_k = int(MAX_OUTPUT_LENGTH/1000) . "K";
- $test_log .= "\n[Output truncated after $max_k]\n\n";
- }
- # Flag automated report
- my $default_comment = $ENV{AUTOMATED_TESTING}
- ? "this report is from an automated smoke testing program\nand was not reviewed by a human for accuracy"
- : "none provided" ;
-
- # generate report
- my $output = << "ENDREPORT";
-Dear $data->{author},
-
-This is a computer-generated report for $data->{dist_name}
-on perl $data->{perl_version}, created by CPAN-Reporter-$CPAN::Reporter::VERSION\.
-
-$intro_para{ $data->{grade} }
-Sections of this report:
-
- * Tester comments
- * Program output
- * Prerequisites
- * Environment and other context
-
-------------------------------
-TESTER COMMENTS
-------------------------------
-
-Additional comments from tester:
-
-$default_comment
-
-------------------------------
-PROGRAM OUTPUT
-------------------------------
-
-Output from '$data->{command}':
-
-$test_log
-------------------------------
-PREREQUISITES
-------------------------------
-
-Prerequisite modules loaded:
-
-$data->{prereq_pm}
-------------------------------
-ENVIRONMENT AND OTHER CONTEXT
-------------------------------
-
-Environment variables:
-
-$data->{env_vars}
-Perl special variables (and OS-specific diagnostics, for MSWin32):
-
-$data->{special_vars}
-Perl module toolchain versions installed:
-
-$data->{toolchain_versions}
-ENDREPORT
-
- return $output;
-}
-
-
-#--------------------------------------------------------------------------#
-# _should_copy_author
-#--------------------------------------------------------------------------#
-
-sub _should_copy_author {
- my ($result, $config) = @_;
-
- # User prompts for action
- my $author_email = $result->{author_id}
- ? "$result->{author_id}\@cpan.org"
- : q{};
- if ( ! $author_email ) {
- $CPAN::Frontend->mywarn( "CPAN::Reporter: couldn't determine author_id and won't cc author.\n");
- return;
- }
-
- # Skip if distribution name matches the cc_skipfile
- if ( $config->{cc_skipfile} && -r $config->{cc_skipfile} ) {
- my $cc_skipfile = IO::File->new( $config->{cc_skipfile}, "r" );
- my $dist_id = $result->{dist}->pretty_id;
- while ( my $pattern = <$cc_skipfile> ) {
- chomp($pattern);
- # ignore comments
- next if substr($pattern,0,1) eq '#';
- # if it doesn't match, continue with next pattern
- next if $dist_id !~ /$pattern/i;
- # if it matches, warn and return
- $CPAN::Frontend->myprint( << "END_SKIP_DIST" );
-CPAN::Reporter: '$dist_id' matched against the cc_skipfile. Won't copy author.
-END_SKIP_DIST
- return;
- }
- }
-
- # Don't copy author on perls with patchlevels
- return if $Config{perl_patchlevel};
-
- # Finally, prompt user if necessary
- if ( _prompt( $config, "cc_author", $result->{grade}, "($author_email)?") =~ /^y/ ) {
- return $author_email;
- }
- else {
- return;
- }
-}
-
-#--------------------------------------------------------------------------#
-# _special_vars_report
-#--------------------------------------------------------------------------#
-
-sub _special_vars_report {
- my $special_vars = << "HERE";
- \$^X = $^X
- \$UID/\$EUID = $< / $>
- \$GID = $(
- \$EGID = $)
-HERE
- if ( $^O eq 'MSWin32' && eval "require Win32" ) { ## no critic
- my @getosversion = Win32::GetOSVersion();
- my $getosversion = join(", ", @getosversion);
- $special_vars .= " Win32::GetOSName = " . Win32::GetOSName() . "\n";
- $special_vars .= " Win32::GetOSVersion = $getosversion\n";
- $special_vars .= " Win32::FsType = " . Win32::FsType() . "\n";
- $special_vars .= " Win32::IsAdminUser = " . Win32::IsAdminUser() . "\n";
- }
- return $special_vars;
-}
-
-#--------------------------------------------------------------------------#
-# _split_redirect
-#--------------------------------------------------------------------------#
-
-sub _split_redirect {
- my $command = shift;
- my ($cmd, $prefix) = ($command =~ m{\A(.+?)(\|.*)\z});
- if (defined $cmd) {
- return ($cmd, $prefix);
- }
- else { # didn't match a redirection
- return $command
- }
-}
-
-#--------------------------------------------------------------------------#
-# _temp_filename -- stand-in for File::Temp for backwards compatibility
-#
-# takes an optional prefix, adds 8 random chars and returns
-# an absolute pathname
-#
-# NOTE -- manual unlink required
-#--------------------------------------------------------------------------#
-
-# @CHARS from File::Temp
-my @CHARS = (qw/ A B C D E F G H I J K L M N O P Q R S T U V W X Y Z
- a b c d e f g h i j k l m n o p q r s t u v w x y z
- 0 1 2 3 4 5 6 7 8 9 _
- /);
-
-sub _temp_filename {
- my ($prefix) = @_;
- $prefix = q{} unless defined $prefix;
- $prefix .= $CHARS[ int( rand(@CHARS) ) ] for 0 .. 7;
- return File::Spec->catfile(File::Spec->tmpdir(), $prefix);
-}
-
-#--------------------------------------------------------------------------#
-# _timeout_wrapper
-#--------------------------------------------------------------------------#
-
-sub _timeout_wrapper {
- my ($cmd, $timeout) = @_;
-
- # protect shell quotes
- $cmd = quotemeta($cmd);
-
- my $wrapper = sprintf << 'HERE', $timeout, $cmd, $cmd;
-use strict;
-my ($pid, $exitcode);
-eval {
- local $SIG{CHLD};
- local $SIG{ALRM} = sub {die 'Timeout'};
- $pid = fork;
- die "Cannot fork: $!\n" unless defined $pid;
- if ($pid) { #parent
- alarm %s;
- my $wstat = waitpid $pid, 0;
- $exitcode = $wstat == -1 ? -1 : $?;
- } else { #child
- setpgrp; # new process group for targeted kill
- exec "%s";
- }
-};
-alarm 0;
-if ($pid && $@ =~ /Timeout/){
- kill -9, $pid;
- my $wstat = waitpid $pid, 0;
- $exitcode = $wstat == -1 ? -1 : $?;
-}
-elsif ($@) {
- die $@;
-}
-print "(%s exited with $exitcode)\n";
-HERE
- return $wrapper;
-}
-
-#--------------------------------------------------------------------------#
-# _timeout_wrapper_win32
-#--------------------------------------------------------------------------#
-
-sub _timeout_wrapper_win32 {
- my ($cmd, $timeout) = @_;
-
- $timeout ||= 0; # just in case upstream doesn't guarantee it
-
- eval "use Win32::Job ();";
- if ($@) {
- $CPAN::Frontend->mywarn( << 'HERE' );
-CPAN::Reporter: you need Win32::Job for inactivity_timeout support.
-Continuing without timeout...
-HERE
- return;
- }
-
- my ($program) = split " ", $cmd;
- if (! File::Spec->file_name_is_absolute( $program ) ) {
- my $exe = $program . ".exe";
- my ($path) = grep { -e File::Spec->catfile($_,$exe) }
- split /$Config{path_sep}/, $ENV{PATH};
- if (! $path) {
- $CPAN::Frontend->mywarn( << "HERE" );
-CPAN::Reporter: can't locate $exe in the PATH.
-Continuing without timeout...
-HERE
- return;
- }
- $program = File::Spec->catfile($path,$exe);
- }
-
- # protect shell quotes and other things
- $_ = quotemeta($_) for ($program, $cmd);
-
- my $wrapper = sprintf << 'HERE', $program, $cmd, $timeout;
-use strict;
-use Win32::Job;
-my $executable = "%s";
-my $cmd_line = "%s";
-my $timeout = %s;
-
-my $job = Win32::Job->new() or die $^E;
-my $ppid = $job->spawn($executable, $cmd_line);
-$job->run($timeout);
-my $status = $job->status;
-my $exitcode = $status->{$ppid}{exitcode};
-if ( $exitcode == 293 ) {
- $exitcode = 9; # map Win32::Job kill (293) to SIGKILL (9)
-}
-elsif ( $exitcode & 255 ) {
- $exitcode = $exitcode << 8; # how perl expects it
-}
-print "($cmd_line exited with $exitcode)\n";
-HERE
- return $wrapper;
-}
-
-#--------------------------------------------------------------------------#-
-# _toolchain_report
-#--------------------------------------------------------------------------#
-
-my @toolchain_mods= qw(
- CPAN
- Cwd
- ExtUtils::CBuilder
- ExtUtils::Command
- ExtUtils::Install
- ExtUtils::MakeMaker
- ExtUtils::Manifest
- ExtUtils::ParseXS
- File::Spec
- Module::Build
- Module::Signature
- Test::Harness
- Test::More
- version
- YAML
- YAML::Syck
-);
-
-sub _toolchain_report {
- my ($result) = @_;
-
- my $installed = _version_finder( map { $_ => 0 } @toolchain_mods );
- $result->{toolchain} = $installed;
-
- my $mod_width = _max_length( keys %$installed );
- my $ver_width = _max_length(
- map { $installed->{$_}{have} } keys %$installed
- );
-
- my $format = " \%-${mod_width}s \%-${ver_width}s\n";
-
- my $report = "";
- $report .= sprintf( $format, "Module", "Have" );
- $report .= sprintf( $format, "-" x $mod_width, "-" x $ver_width );
-
- for my $var ( sort keys %$installed ) {
- $report .= sprintf(" \%-${mod_width}s \%-${ver_width}s\n",
- $var, $installed->{$var}{have} );
- }
-
- return $report;
-}
-
-
-
-#--------------------------------------------------------------------------#
-# _version_finder
-#
-# module => version pairs
-#
-# This is done via an external program to show installed versions exactly
-# the way they would be found when test programs are run. This means that
-# any updates to PERL5LIB will be reflected in the results.
-#
-# File-finding logic taken from CPAN::Module::inst_file(). Logic to
-# handle newer Module::Build prereq syntax is taken from
-# CPAN::Distribution::unsat_prereq()
-#
-#--------------------------------------------------------------------------#
-
-my $version_finder = $INC{'CPAN/Reporter/PrereqCheck.pm'};
-
-sub _version_finder {
- my %prereqs = @_;
-
- my $perl = Probe::Perl->find_perl_interpreter();
- my @prereq_results;
-
- my $prereq_input = _temp_filename( 'CPAN-Reporter-PI-' );
- my $fh = IO::File->new( $prereq_input, "w" )
- or die "Could not create temporary '$prereq_input' for prereq analysis: $!";
- $fh->print( map { "$_ $prereqs{$_}\n" } keys %prereqs );
- $fh->close;
-
- my $prereq_result = qx/$perl $version_finder < $prereq_input/;
-
- unlink $prereq_input;
-
- my %result;
- for my $line ( split "\n", $prereq_result ) {
- next unless length $line;
- my ($mod, $met, $have) = split " ", $line;
- unless ( defined($mod) && defined($met) && defined($have) ) {
- $CPAN::Frontend->mywarn(
- "Error parsing output from CPAN::Reporter::PrereqCheck:\n" .
- $line
- );
- next;
- }
- $result{$mod}{have} = $have;
- $result{$mod}{met} = $met;
- }
- return \%result;
-}
-
-1; #this line is important and will help the module return a true value
-
-__END__
-
-#--------------------------------------------------------------------------#
-# pod documentation
-#--------------------------------------------------------------------------#
-
-=begin wikidoc
-
-= NAME
-
-CPAN::Reporter - Adds CPAN Testers reporting to CPAN.pm
-
-= VERSION
-
-This documentation describes version %%VERSION%%.
-
-= SYNOPSIS
-
-From the CPAN shell:
-
- cpan> install CPAN::Reporter
- cpan> reload cpan
- cpan> o conf init test_report
-
-= DESCRIPTION
-
-The CPAN Testers project captures and analyses detailed results from building
-and testing CPAN distributions on multiple operating systems and multiple
-versions of Perl. This provides valuable feedback to module authors and
-potential users to identify bugs or platform compatibility issues and improves
-the overall quality and value of CPAN.
-
-One way individuals can contribute is to send a report for each module that
-they test or install. CPAN::Reporter is an add-on for the CPAN.pm module to
-send the results of building and testing modules to the CPAN Testers project.
-Full support for CPAN::Reporter is available in CPAN.pm as of version 1.92.
-
-= GETTING STARTED
-
-== Installation
-
-The first step in using CPAN::Reporter is to install it using whatever
-version of CPAN.pm is already installed. CPAN.pm will be upgraded as
-a dependency if necessary.
-
- cpan> install CPAN::Reporter
-
-If CPAN.pm was upgraded, it needs to be reloaded.
-
- cpan> reload cpan
-
-== Configuration
-
-If upgrading from a very old version of CPAN.pm, users may be prompted to renew
-their configuration settings, including the 'test_report' option to enable
-CPAN::Reporter.
-
-If not prompted automatically, users should manually initialize CPAN::Reporter
-support. After enabling CPAN::Reporter, CPAN.pm will automatically continue
-with interactive configuration of CPAN::Reporter options.
-
- cpan> o conf init test_report
-
-Users will need to enter an email address in one of the following formats:
-
- johndoe@example.com
- John Doe <johndoe@example.com>
- "John Q. Public" <johnqpublic@example.com>
-
-Because {cpan-testers} uses a mailing list to collect test reports, it is
-helpful if the email address provided is subscribed to the list. Otherwise,
-test reports will be held until manually reviewed and approved. Subscribing an
-account to the cpan-testers list is as easy as sending a blank email to
-cpan-testers-subscribe@perl.org and replying to the confirmation email.
-
-Users will also be prompted to enter the name of an outbound email server. It
-is recommended to use an email server provided by the user's ISP or company.
-Alternatively, leave this blank to attempt to send email directly to perl.org.
-
-Users that are new to CPAN::Reporter should accept the recommended values
-for other configuration options.
-
-After completing interactive configuration, be sure to commit (save) the CPAN
-configuration changes.
-
- cpan> o conf commit
-
-See [CPAN::Reporter::Config] for advanced configuration settings.
-
-== Using CPAN::Reporter
-
-Once CPAN::Reporter is enabled and configured, test or install modules with
-CPAN.pm as usual.
-
-For example, to force CPAN to repeat tests for CPAN::Reporter to see how it
-works:
-
- cpan> force test CPAN::Reporter
-
-When distribution tests fail, users will be prompted to edit the report to add
-addition information.
-
-= UNDERSTANDING TEST GRADES
-
-CPAN::Reporter will assign one of the following grades to the report:
-
-* {pass} -- all tests were successful
-
-* {fail} -- one or more tests failed, one or more test files died during
-testing or no test output was seen
-
-* {na} -- tests could not be run on this platform or version of perl
-
-* {unknown} -- no test files could be found (either t/*.t or test.pl) or
-a result could not be determined from test output (e.g tests may have hung
-and been interrupted)
-
-In returning results to CPAN.pm, "pass" and "unknown" are considered successful
-attempts to "make test" or "Build test" and will not prevent installation.
-"fail" and "na" are considered to be failures and CPAN.pm will not install
-unless forced.
-
-If prerequisites specified in {Makefile.PL} or {Build.PL} are not available,
-no report will be generated and a failure will be signaled to CPAN.pm.
-
-= PRIVACY WARNING
-
-CPAN::Reporter includes information in the test report about environment
-variables and special Perl variables that could be affecting test results in
-order to help module authors interpret the results of the tests. This includes
-information about paths, terminal, locale, user/group ID, installed toolchain
-modules (e.g. ExtUtils::MakeMaker) and so on.
-
-These have been intentionally limited to items that should not cause harmful
-personal information to be revealed -- it does ~not~ include your entire
-environment. Nevertheless, please do not use CPAN::Reporter if you are
-concerned about the disclosure of this information as part of your test report.
-
-Users wishing to review this information may choose to edit the report
-prior to sending it.
-
-= BUGS
-
-Please report any bugs or feature using the CPAN Request Tracker.
-Bugs can be submitted through the web interface at
-[http://rt.cpan.org/Dist/Display.html?Queue=CPAN-Reporter]
-
-When submitting a bug or request, please include a test-file or a patch to an
-existing test-file that illustrates the bug or desired feature.
-
-= SEE ALSO
-
-Information about CPAN::Testers:
-
-* [CPAN::Testers] -- overview of CPAN Testers architecture stack
-* [http://cpantesters.perl.org] -- project home with all reports
-* [http://cpantest.grango.org] -- documentation and wiki
-
-Additional Documentation:
-
-* [CPAN::Reporter::Config] -- advanced configuration settings
-* [CPAN::Reporter::FAQ] -- hints and tips
-
-= AUTHOR
-
-David A. Golden (DAGOLDEN)
-
-= COPYRIGHT AND LICENSE
-
-Copyright (c) 2006, 2007, 2008 by David A. Golden
-
-Licensed under the Apache License, Version 2.0 (the "License");
-you may not use this file except in compliance with the License.
-You may obtain a copy of the License at
-[http://www.apache.org/licenses/LICENSE-2.0]
-
-Unless required by applicable law or agreed to in writing, software
-distributed under the License is distributed on an "AS IS" BASIS,
-WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-See the License for the specific language governing permissions and
-limitations under the License.
-
-=end wikidoc
-
-=cut
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/CPAN/Reporter.pod b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/CPAN/Reporter.pod
deleted file mode 100644
index 5e573fc710c..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/CPAN/Reporter.pod
+++ /dev/null
@@ -1,224 +0,0 @@
-# Generated by Pod::WikiDoc version 0.18
-
-=pod
-
-=head1 NAME
-
-CPAN::Reporter - Adds CPAN Testers reporting to CPAN.pm
-
-=head1 VERSION
-
-This documentation describes version 1.13.
-
-=head1 SYNOPSIS
-
-From the CPAN shell:
-
- cpan> install CPAN::Reporter
- cpan> reload cpan
- cpan> o conf init test_report
-
-=head1 DESCRIPTION
-
-The CPAN Testers project captures and analyses detailed results from building
-and testing CPAN distributions on multiple operating systems and multiple
-versions of Perl. This provides valuable feedback to module authors and
-potential users to identify bugs or platform compatibility issues and improves
-the overall quality and value of CPAN.
-
-One way individuals can contribute is to send a report for each module that
-they test or install. CPAN::Reporter is an add-on for the CPAN.pm module to
-send the results of building and testing modules to the CPAN Testers project.
-Full support for CPAN::Reporter is available in CPAN.pm as of version 1.92.
-
-=head1 GETTING STARTED
-
-=head2 Installation
-
-The first step in using CPAN::Reporter is to install it using whatever
-version of CPAN.pm is already installed. CPAN.pm will be upgraded as
-a dependency if necessary.
-
- cpan> install CPAN::Reporter
-
-If CPAN.pm was upgraded, it needs to be reloaded.
-
- cpan> reload cpan
-
-=head2 Configuration
-
-If upgrading from a very old version of CPAN.pm, users may be prompted to renew
-their configuration settings, including the 'test_report' option to enable
-CPAN::Reporter.
-
-If not prompted automatically, users should manually initialize CPAN::Reporter
-support. After enabling CPAN::Reporter, CPAN.pm will automatically continue
-with interactive configuration of CPAN::Reporter options.
-
- cpan> o conf init test_report
-
-Users will need to enter an email address in one of the following formats:
-
- johndoe@example.com
- John Doe <johndoe@example.com>
- "John Q. Public" <johnqpublic@example.com>
-
-Because C<<< cpan-testers >>> uses a mailing list to collect test reports, it is
-helpful if the email address provided is subscribed to the list. Otherwise,
-test reports will be held until manually reviewed and approved. Subscribing an
-account to the cpan-testers list is as easy as sending a blank email to
-cpan-testers-subscribe@perl.org and replying to the confirmation email.
-
-Users will also be prompted to enter the name of an outbound email server. It
-is recommended to use an email server provided by the user's ISP or company.
-Alternatively, leave this blank to attempt to send email directly to perl.org.
-
-Users that are new to CPAN::Reporter should accept the recommended values
-for other configuration options.
-
-After completing interactive configuration, be sure to commit (save) the CPAN
-configuration changes.
-
- cpan> o conf commit
-
-See L<CPAN::Reporter::Config> for advanced configuration settings.
-
-=head2 Using CPAN::Reporter
-
-Once CPAN::Reporter is enabled and configured, test or install modules with
-CPAN.pm as usual.
-
-For example, to force CPAN to repeat tests for CPAN::Reporter to see how it
-works:
-
- cpan> force test CPAN::Reporter
-
-When distribution tests fail, users will be prompted to edit the report to add
-addition information.
-
-=head1 UNDERSTANDING TEST GRADES
-
-CPAN::Reporter will assign one of the following grades to the report:
-
-=over
-
-=item *
-
-C<<< pass >>> -- all tests were successful
-
-=back
-
-=over
-
-=item *
-
-C<<< fail >>> -- one or more tests failed, one or more test files died during
-testing or no test output was seen
-
-=back
-
-=over
-
-=item *
-
-C<<< na >>> -- tests could not be run on this platform or version of perl
-
-=back
-
-=over
-
-=item *
-
-C<<< unknown >>> -- no test files could be found (either tE<sol>*.t or test.pl) or
-a result could not be determined from test output (e.g tests may have hung
-and been interrupted)
-
-=back
-
-In returning results to CPAN.pm, "pass" and "unknown" are considered successful
-attempts to "make test" or "Build test" and will not prevent installation.
-"fail" and "na" are considered to be failures and CPAN.pm will not install
-unless forced.
-
-If prerequisites specified in C<<< Makefile.PL >>> or C<<< Build.PL >>> are not available,
-no report will be generated and a failure will be signaled to CPAN.pm.
-
-=head1 PRIVACY WARNING
-
-CPAN::Reporter includes information in the test report about environment
-variables and special Perl variables that could be affecting test results in
-order to help module authors interpret the results of the tests. This includes
-information about paths, terminal, locale, userE<sol>group ID, installed toolchain
-modules (e.g. ExtUtils::MakeMaker) and so on.
-
-These have been intentionally limited to items that should not cause harmful
-personal information to be revealed -- it does I<not> include your entire
-environment. Nevertheless, please do not use CPAN::Reporter if you are
-concerned about the disclosure of this information as part of your test report.
-
-Users wishing to review this information may choose to edit the report
-prior to sending it.
-
-=head1 BUGS
-
-Please report any bugs or feature using the CPAN Request Tracker.
-Bugs can be submitted through the web interface at
-L<http://rt.cpan.org/Dist/Display.html?Queue=CPAN-Reporter>
-
-When submitting a bug or request, please include a test-file or a patch to an
-existing test-file that illustrates the bug or desired feature.
-
-=head1 SEE ALSO
-
-Information about CPAN::Testers:
-
-=over
-
-=item *
-
-L<CPAN::Testers> -- overview of CPAN Testers architecture stack
-
-=item *
-
-L<http://cpantesters.perl.org> -- project home with all reports
-
-=item *
-
-L<http://cpantest.grango.org> -- documentation and wiki
-
-=back
-
-Additional Documentation:
-
-=over
-
-=item *
-
-L<CPAN::Reporter::Config> -- advanced configuration settings
-
-=item *
-
-L<CPAN::Reporter::FAQ> -- hints and tips
-
-=back
-
-=head1 AUTHOR
-
-David A. Golden (DAGOLDEN)
-
-=head1 COPYRIGHT AND LICENSE
-
-Copyright (c) 2006, 2007, 2008 by David A. Golden
-
-Licensed under the Apache License, Version 2.0 (the "License");
-you may not use this file except in compliance with the License.
-You may obtain a copy of the License at
-L<http://www.apache.org/licenses/LICENSE-2.0>
-
-Unless required by applicable law or agreed to in writing, software
-distributed under the License is distributed on an "AS IS" BASIS,
-WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-See the License for the specific language governing permissions and
-limitations under the License.
-
-
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/CPAN/Reporter/API.pod b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/CPAN/Reporter/API.pod
deleted file mode 100644
index 8e01c452fa1..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/CPAN/Reporter/API.pod
+++ /dev/null
@@ -1,135 +0,0 @@
-# Generated by Pod::WikiDoc version 0.18
-
-=pod
-
-=head1 NAME
-
-CPAN::Reporter::API - Programmer's interface to CPAN::Reporter
-
-=head1 VERSION
-
-This documentation refers to version 1.13
-
-=head1 FUNCTIONS
-
-CPAN::Reporter provides only a few public function for use within CPAN.pm.
-They are not imported during C<<< use >>>. Ordinary users will never need them.
-
-=head2 C<<< configure() >>>
-
- CPAN::Reporter::configure();
-
-Prompts the user to edit configuration settings stored in the CPAN::Reporter
-C<<< config.ini >>> file. It will create the configuration file if it does not exist.
-It is automatically called by CPAN.pm when initializing the 'test_report'
-option, e.g.:
-
- cpan> o conf init test_report
-
-=head2 C<<< record_command() >>>
-
- ($output, $exit_value) = CPAN::Reporter::record_command( $cmd, $secs );
-
-Takes a command to be executed via system(), but wraps and tees it to
-show the output to the console, capture the output, and capture the
-exit code. Returns an array reference of output lines (merged STDOUT and
-STDERR) and the return value from system(). Note that this is C<<< $? >>>, so the
-actual exit value of the command will need to be extracted as described in
-L<perlvar>.
-
-If the command includes a pipe character ('E<verbar>'), only the part of the
-command prior to the pipe will be wrapped and teed. The pipe will be
-applied to the execution of the wrapper script. This is essential to
-capture the exit value of the command and should be otherwise transparent.
-
-If a non-zero C<<< $secs >>> argument is provided, the command will be run with
-a timeout of C<<< $secs >>> (seconds). On Win32, L<Win32::Job> must be
-available or code will fall-back to running without a timeout; also, the
-first space-separated element of the command must be absolute, or else
-".exe" will be appended and the PATH searched for a matching command.
-
-If the attempt to record fails, a warning will be issued and one or more of
-C<<< $output >>> or C<<< $exit_value >>> will be undefined.
-
-=head2 C<<< grade_make() >>>
-
- CPAN::Reporter::grade_make( $dist, $command, \@output, $exit);
-
-Given a CPAN::Distribution object, the system command used to build the
-distribution (e.g. "make", "perl Build"), an array of lines of output from the
-command and the exit value from the command, C<<< grade_make() >>> determines a grade
-for this stage of distribution installation. If the grade is "pass",
-C<<< grade_make() >>> does B<not> send a CPAN Testers report for this stage and returns
-true to signal that the build was successful. Otherwise, a CPAN Testers report
-is sent and C<<< grade_make() >>> returns false.
-
-=head2 C<<< grade_PL() >>>
-
- CPAN::Reporter::grade_PL( $dist, $command, \@output, $exit);
-
-Given a CPAN::Distribution object, the system command used to run Makefile.PL
-or Build.PL (e.g. "perl Makefile.PL"), an array of lines of output from the
-command and the exit value from the command, C<<< grade_PL() >>> determines a grade
-for this stage of distribution installation. If the grade is "pass",
-C<<< grade_PL() >>> does B<not> send a CPAN Testers report for this stage and returns
-true to signal that the Makefile.PL or Build.PL ran successfully. Otherwise, a
-CPAN Testers report is sent and C<<< grade_PL() >>> returns false.
-
-=head2 C<<< grade_test() >>>
-
- CPAN::Reporter::grade_test( $dist, $command, \@output, $exit);
-
-Given a CPAN::Distribution object, the system command used to run tests (e.g.
-"make test"), an array of lines of output from testing and the exit value from
-the system command, C<<< grade_test() >>> determines a grade for distribution tests.
-A CPAN Testers report is then sent unless specified prerequisites were not
-satisfied, in which case the report is discarded. This function returns true
-if the grade is "pass" or "unknown" and returns false, otherwise.
-
-=head2 C<<< test() >>> -- DEPRECATED
-
- CPAN::Reporter::test( $cpan_dist, $system_command );
-
-This function is maintained for backwards compatibility. It effectively
-wraps the functionality of C<<< record_command() >>> and C<<< grade_test() >>> into
-a single function call. It takes a CPAN::Distribution object and the system
-command to run distribution tests.
-
-=head1 SEE ALSO
-
-=over
-
-=item *
-
-L<CPAN::Reporter>
-
-=item *
-
-L<CPAN::Reporter::Config>
-
-=item *
-
-L<CPAN::Reporter::FAQ>
-
-=back
-
-=head1 AUTHOR
-
-David A. Golden (DAGOLDEN)
-
-=head1 COPYRIGHT AND LICENSE
-
-Copyright (c) 2006, 2007, 2008 by David A. Golden
-
-Licensed under the Apache License, Version 2.0 (the "License");
-you may not use this file except in compliance with the License.
-You may obtain a copy of the License at
-L<http://www.apache.org/licenses/LICENSE-2.0>
-
-Unless required by applicable law or agreed to in writing, software
-distributed under the License is distributed on an "AS IS" BASIS,
-WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-See the License for the specific language governing permissions and
-limitations under the License.
-
-
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/CPAN/Reporter/Config.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/CPAN/Reporter/Config.pm
deleted file mode 100644
index bb97dd100da..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/CPAN/Reporter/Config.pm
+++ /dev/null
@@ -1,764 +0,0 @@
-package CPAN::Reporter::Config;
-use strict;
-use vars qw/$VERSION/;
-$VERSION = '1.13';
-$VERSION = eval $VERSION;
-
-use Config::Tiny ();
-use File::HomeDir ();
-use File::Path (qw/mkpath/);
-use File::Spec ();
-use IO::File ();
-use CPAN (); # for printing warnings
-
-#--------------------------------------------------------------------------#
-# Back-compatibility checks -- just once per load
-#--------------------------------------------------------------------------#
-
-# 0.28_51 changed Mac OS X config file location -- if old directory is found,
-# move it to the new location
-if ( $^O eq 'darwin' ) {
- my $old = File::Spec->catdir(File::HomeDir->my_documents,".cpanreporter");
- my $new = File::Spec->catdir(File::HomeDir->my_home,".cpanreporter");
- if ( ( -d $old ) && (! -d $new ) ) {
- $CPAN::Frontend->mywarn( << "HERE");
-CPAN::Reporter: since CPAN::Reporter 0.28_51, the Mac OSX config directory
-has changed.
-
- Old: $old
- New: $new
-
-Your existing configuration file will be moved automatically.
-HERE
- mkpath($new);
- my $OLD_CONFIG = IO::File->new(
- File::Spec->catfile($old, "config.ini"), "<"
- ) or die $!;
- my $NEW_CONFIG = IO::File->new(
- File::Spec->catfile($new, "config.ini"), ">"
- ) or die $!;
- $NEW_CONFIG->print( do { local $/; <$OLD_CONFIG> } );
- $OLD_CONFIG->close;
- $NEW_CONFIG->close;
- unlink File::Spec->catfile($old, "config.ini") or die $!;
- rmdir($old) or die $!;
- }
-}
-
-#--------------------------------------------------------------------------#
-# Public
-#--------------------------------------------------------------------------#
-
-sub _configure {
- my $config_dir = _get_config_dir();
- my $config_file = _get_config_file();
-
- mkpath $config_dir if ! -d $config_dir;
- if ( ! -d $config_dir ) {
- $CPAN::Frontend->myprint(
- "\nCPAN::Reporter: couldn't create configuration directory '$config_dir': $!"
- );
- return;
- }
-
- my $config;
- my $existing_options;
-
- # explain grade:action pairs
- $CPAN::Frontend->myprint( _grade_action_prompt() );
-
- # read or create
- if ( -f $config_file ) {
- $CPAN::Frontend->myprint(
- "\nCPAN::Reporter: found your CPAN::Reporter config file at:\n$config_file\n"
- );
- $config = _open_config_file();
- # if we can't read it, bail out
- if ( ! $config ) {
- $CPAN::Frontend->mywarn("\n
- CPAN::Reporter: configuration will not be changed\n");
- return;
- }
- # clone what's in the config file
- $existing_options = { %{$config->{_}} } if $config;
- $CPAN::Frontend->myprint(
- "\nCPAN::Reporter: Updating your CPAN::Reporter configuration settings:\n"
- );
- }
- else {
- $CPAN::Frontend->myprint(
- "\nCPAN::Reporter: no config file found; creating a new one.\n"
- );
- $config = Config::Tiny->new();
- }
-
- my %spec = _config_spec();
-
- for my $k ( _config_order() ) {
- my $option_data = $spec{$k};
- $CPAN::Frontend->myprint( "\n" . $option_data->{info}. "\n");
- # options with defaults are mandatory
- if ( defined $option_data->{default} ) {
- # if we have a default, always show as a sane recommendation
- if ( length $option_data->{default} ) {
- $CPAN::Frontend->myprint(
- "(Recommended: '$option_data->{default}')\n\n"
- );
- }
- # repeat until validated
- PROMPT:
- while ( defined (
- my $answer = CPAN::Shell::colorable_makemaker_prompt(
- "$k?",
- $existing_options->{$k} || $option_data->{default}
- )
- )) {
- if ( ! $option_data->{validate} ||
- $option_data->{validate}->($k, $answer)
- ) {
- $config->{_}{$k} = $answer;
- last PROMPT;
- }
- }
- }
- else {
- # only initialize options without default if
- # answer matches non white space and validates,
- # otherwise reset it
- my $answer = CPAN::Shell::colorable_makemaker_prompt(
- "$k?",
- $existing_options->{$k} || q{}
- );
- if ( $answer =~ /\S/ ) {
- $config->{_}{$k} = $answer;
- }
- else {
- delete $config->{_}{$k};
- }
- }
- # delete existing as we proceed so we know what's left
- delete $existing_options->{$k};
- }
-
- # initialize remaining existing options
- $CPAN::Frontend->myprint(
- "\nYour CPAN::Reporter config file also contains these advanced " .
- "options:\n\n") if keys %$existing_options;
- for my $k ( keys %$existing_options ) {
- $config->{_}{$k} = CPAN::Shell::colorable_makemaker_prompt(
- "$k?", $existing_options->{$k}
- );
- }
-
- $CPAN::Frontend->myprint(
- "\nCPAN::Reporter: writing config file to '$config_file'.\n"
- );
- if ( $config->write( $config_file ) ) {
- return $config->{_};
- }
- else {
- $CPAN::Frontend->mywarn( "\nCPAN::Reporter: error writing config file to '$config_file':\n"
- . Config::Tiny->errstr(). "\n");
- return;
- }
-}
-
-#--------------------------------------------------------------------------#
-# Private
-#--------------------------------------------------------------------------#
-
-#--------------------------------------------------------------------------#
-# _config_order -- determines order of interactive config. Only items
-# in interactive config will be written to a starter config file
-#--------------------------------------------------------------------------#
-
-sub _config_order {
- return qw(
- email_from
- smtp_server
- edit_report
- send_report
- );
-}
-
-#--------------------------------------------------------------------------#
-# _config_spec -- returns configuration options information
-#
-# Keys include
-# default -- recommended value, used in prompts and as a fallback
-# if an options is not set; mandatory if defined
-# prompt -- short prompt for EU::MM prompting
-# info -- long description shown before prompting
-# validate -- CODE ref; return normalized option or undef if invalid
-#--------------------------------------------------------------------------#
-
-my %option_specs = (
- email_from => {
- default => '',
- prompt => 'What email address will be used for sending reports?',
- info => <<'HERE',
-CPAN::Reporter requires a valid email address as the return address
-for test reports sent to cpan-testers\@perl.org. Either provide just
-an email address, or put your real name in double-quote marks followed
-by your email address in angle marks, e.g. "John Doe" <jdoe@nowhere.com>.
-Note: unless this email address is subscribed to the cpan-testers mailing
-list, your test reports will not appear until manually reviewed.
-HERE
- },
- smtp_server => {
- default => undef, # optional
- info => <<'HERE',
-If your computer is behind a firewall or your ISP blocks
-outbound mail traffic, CPAN::Reporter will not be able to send
-test reports unless you provide an alternate outbound (SMTP)
-email server. Enter the full name of your outbound mail server
-(e.g. smtp.your-ISP.com) or leave this blank to send mail
-directly to perl.org. Use a space character to reset this value
-to sending to perl.org.
-HERE
- },
- edit_report => {
- default => 'default:ask/no pass/na:no',
- prompt => "Do you want to review or edit the test report?",
- validate => \&_validate_grade_action_pair,
- info => <<'HERE',
-Before test reports are sent, you may want to review or edit the test
-report and add additional comments about the result or about your system
-or Perl configuration. By default, CPAN::Reporter will ask after
-each report is generated whether or not you would like to edit the
-report. This option takes "grade:action" pairs.
-HERE
- },
- send_report => {
- default => 'default:ask/yes pass/na:yes',
- prompt => "Do you want to send the report?",
- validate => \&_validate_grade_action_pair,
- info => <<'HERE',
-By default, CPAN::Reporter will prompt you for confirmation that
-the test report should be sent before actually emailing the
-report. This gives the opportunity to bypass sending particular
-reports if you need to (e.g. if you caused the failure).
-This option takes "grade:action" pairs.
-HERE
- },
- cc_author => {
- default => 'default:yes pass/na:no',
- prompt => "Do you want to CC the module author ", # (author@cpan.org) added dynamically
- validate => \&_validate_grade_action_pair,
- info => <<'HERE',
-If you would like, CPAN::Reporter will copy the module author with
-the results of your tests. By default, authors are copied only on
-failed/unknown results. This option takes "grade:action" pairs.
-HERE
- },
- send_duplicates => {
- default => 'default:no',
- prompt => "This report is identical to a previous one. Send it anyway?",
- validate => \&_validate_grade_action_pair,
- info => <<'HERE',
-CPAN::Reporter records tests grades for each distribution, version and
-platform. By default, duplicates of previous results will not be sent at
-all, regardless of the value of the "send_report" option. This option takes
-"grade:action" pairs.
-HERE
- },
- send_PL_report => {
- prompt => "Do you want to send the PL report?",
- default => undef,
- validate => \&_validate_grade_action_pair,
- },
- send_make_report => {
- prompt => "Do you want to send the make/Build report?",
- default => undef,
- validate => \&_validate_grade_action_pair,
- },
- send_test_report => {
- prompt => "Do you want to send the test report?",
- default => undef,
- validate => \&_validate_grade_action_pair,
- },
- send_skipfile => {
- prompt => "What file has patterns for things that shouldn't be reported?",
- default => undef,
- validate => \&_validate_skipfile,
- },
- cc_skipfile => {
- prompt => "What file has patterns for things that shouldn't CC to authors?",
- default => undef,
- validate => \&_validate_skipfile,
- },
- command_timeout => {
- prompt => "If no timeout is set by CPAN, halt system commands after how many seconds?",
- default => undef,
- validate => \&_validate_seconds,
- },
- email_to => {
- default => undef,
- },
- editor => {
- default => undef,
- },
- transport => {
- default => undef,
- },
- debug => {
- default => undef,
- },
-);
-
-sub _config_spec { return %option_specs }
-
-#--------------------------------------------------------------------------#
-# _get_config_dir
-#--------------------------------------------------------------------------#
-
-sub _get_config_dir {
- if ( defined $ENV{PERL_CPAN_REPORTER_DIR} ) {
- return $ENV{PERL_CPAN_REPORTER_DIR};
- }
- else {
- return ( $^O eq 'MSWin32' )
- ? File::Spec->catdir(File::HomeDir->my_documents, ".cpanreporter")
- : File::Spec->catdir(File::HomeDir->my_home, ".cpanreporter") ;
- }
-}
-
-#--------------------------------------------------------------------------#
-# _get_config_file
-#--------------------------------------------------------------------------#
-
-sub _get_config_file {
- if ( defined $ENV{PERL_CPAN_REPORTER_CONFIG} ) {
- return $ENV{PERL_CPAN_REPORTER_CONFIG};
- }
- else {
- return File::Spec->catdir( _get_config_dir, "config.ini" );
- }
-}
-
-#--------------------------------------------------------------------------#
-# _get_config_options
-#--------------------------------------------------------------------------#
-
-sub _get_config_options {
- my $config = shift;
- # extract and return valid options, with fallback to defaults
- my %spec = CPAN::Reporter::Config::_config_spec();
- my %active;
- OPTION: for my $option ( keys %spec ) {
- if ( exists $config->{_}{$option} ) {
- my $val = $config->{_}{$option};
- if ( $spec{$option}{validate} &&
- ! $spec{$option}{validate}->($option, $val)
- ) {
- $CPAN::Frontend->mywarn( "\nCPAN::Reporter: invalid option '$val' in '$option'. Using default instead.\n\n" );
- $active{$option} = $spec{$option}{default};
- next OPTION;
- }
- $active{$option} = $val;
- }
- else {
- $active{$option} = $spec{$option}{default}
- if defined $spec{$option}{default};
- }
- }
- return \%active;
-}
-
-
-#--------------------------------------------------------------------------#
-# _grade_action_prompt -- describes grade action pairs
-#--------------------------------------------------------------------------#
-
-sub _grade_action_prompt {
- return << 'HERE';
-
-Some of the following configuration options require one or more "grade:action"
-pairs that determine what grade-specific action to take for that option.
-These pairs should be space-separated and are processed left-to-right. See
-CPAN::Reporter documentation for more details.
-
- GRADE : ACTION ======> EXAMPLES
- ------- ------- --------
- pass yes default:no
- fail no default:yes pass:no
- unknown ask/no default:ask/no pass:yes fail:no
- na ask/yes
- default
-
-HERE
-}
-
-#--------------------------------------------------------------------------#
-# _is_valid_action
-#--------------------------------------------------------------------------#
-
-my @valid_actions = qw{ yes no ask/yes ask/no ask };
-sub _is_valid_action {
- my $action = shift;
- return grep { $action eq $_ } @valid_actions;
-}
-
-#--------------------------------------------------------------------------#
-# _is_valid_grade
-#--------------------------------------------------------------------------#
-
-my @valid_grades = qw{ pass fail unknown na default };
-sub _is_valid_grade {
- my $grade = shift;
- return grep { $grade eq $_ } @valid_grades;
-}
-
-#--------------------------------------------------------------------------#
-# _open_config_file
-#--------------------------------------------------------------------------#
-
-sub _open_config_file {
- my $config_file = _get_config_file();
- my $config = Config::Tiny->read( $config_file )
- or $CPAN::Frontend->mywarn("CPAN::Reporter: couldn't read configuration file " .
- "'$config_file': \n" . Config::Tiny->errstr() . "\n");
- return $config;
-}
-
-#--------------------------------------------------------------------------#
-# _validate
-#
-# anything is OK if there is no validation subroutine
-#--------------------------------------------------------------------------#
-
-sub _validate {
- my ($name, $value) = @_;
- return 1 if ! exists $option_specs{$name}{validate};
- return $option_specs{$name}{validate}->($name, $value);
-}
-
-#--------------------------------------------------------------------------#
-# _validate_grade_action
-# returns hash of grade => action
-# returns undef
-#--------------------------------------------------------------------------#
-
-sub _validate_grade_action_pair {
- my ($name, $option) = @_;
- $option ||= "no";
-
- my %ga_map; # grade => action
-
- PAIR: for my $grade_action ( split q{ }, $option ) {
- my ($grade_list,$action);
-
- if ( $grade_action =~ m{.:.} ) {
- # parse pair for later check
- ($grade_list, $action) = $grade_action =~ m{\A([^:]+):(.+)\z};
- }
- elsif ( _is_valid_action($grade_action) ) {
- # action by itself
- $ga_map{default} = $grade_action;
- next PAIR;
- }
- elsif ( _is_valid_grade($grade_action) ) {
- # grade by itself
- $ga_map{$grade_action} = "yes";
- next PAIR;
- }
- elsif( $grade_action =~ m{./.} ) {
- # gradelist by itself, so setup for later check
- $grade_list = $grade_action;
- $action = "yes";
- }
- else {
- # something weird, so warn and skip
- $CPAN::Frontend->mywarn(
- "\nCPAN::Reporter: ignoring invalid grade:action '$grade_action' for '$name'.\n\n"
- );
- next PAIR;
- }
-
- # check gradelist
- my %grades = map { ($_,1) } split( "/", $grade_list);
- for my $g ( keys %grades ) {
- if ( ! _is_valid_grade($g) ) {
- $CPAN::Frontend->mywarn(
- "\nCPAN::Reporter: ignoring invalid grade '$g' in '$grade_action' for '$name'.\n\n"
- );
- delete $grades{$g};
- }
- }
-
- # check action
- if ( ! _is_valid_action($action) ) {
- $CPAN::Frontend->mywarn(
- "\nCPAN::Reporter: ignoring invalid action '$action' in '$grade_action' for '$name'.\n\n"
- );
- next PAIR;
- }
-
- # otherwise, it all must be OK
- $ga_map{$_} = $action for keys %grades;
- }
-
- return scalar(keys %ga_map) ? \%ga_map : undef;
-}
-
-sub _validate_seconds {
- my ($name, $option) = @_;
- return unless defined($option) && length($option)
- && ($option =~ /^\d/) && $option >= 0;
- return $option;
-}
-
-sub _validate_skipfile {
- my ($name, $option) = @_;
- return unless $option;
- my $skipfile = File::Spec->file_name_is_absolute( $option )
- ? $option : File::Spec->catfile( _get_config_dir(), $option );
- return -r $skipfile ? $skipfile : undef;
-}
-
-1;
-__END__
-
-=begin wikidoc
-
-= NAME
-
-CPAN::Reporter::Config - Config file options for CPAN::Reporter
-
-= VERSION
-
-This documentation refers to version %%VERSION%%
-
-= SYNOPSIS
-
-From the CPAN shell:
-
- cpan> o conf init test_report
-
-= DESCRIPTION
-
-Default options for CPAN::Reporter are read from a configuration file
-{.cpanreporter/config.ini} in the user's home directory (Unix and OS X)
-or "My Documents" directory (Windows).
-
-The configuration file is in "ini" format, with the option name and value
-separated by an "=" sign
-
- email_from = "John Doe" <johndoe@nowhere.org>
- cc_author = no
-
-Interactive configuration of email address, mail server and common
-action prompts may be repeated at any time from the CPAN shell.
-
- cpan> o conf init test_report
-
-If a configuration file does not exist, it will be created the first
-time interactive configuration is performed.
-
-Subsequent interactive configuration will also include any advanced
-options that have been added manually to the configuration file.
-
-= INTERACTIVE CONFIGURATION OPTIONS
-
-== Email Address (required)
-
-CPAN::Reporter requires users to provide an email address that will be used
-in the "From" header of the email to cpan-testers@perl.org.
-
-* {email_from = <email address>} -- email address of the user sending the
-test report; it should be a valid address format, e.g.:
-
- user@domain
- John Doe <user@domain>
- "John Q. Public" <user@domain>
-
-Because {cpan-testers} uses a mailing list to collect test reports, it is
-helpful if the email address provided is subscribed to the list. Otherwise,
-test reports will be held until manually reviewed and approved.
-
-Subscribing an account to the cpan-testers list is as easy as sending a blank
-email to cpan-testers-subscribe@perl.org and replying to the confirmation
-email.
-
-== Mail Server
-
-By default, Test::Reporter attempts to send mail directly to perl.org mail
-servers. This may fail if a user's computer is behind a network firewall
-that blocks outbound email. In this case, the following option should
-be set to the outbound mail server (i.e., SMTP server) as provided by
-the user's Internet service provider (ISP):
-
-* {smtp_server = <server list>} -- one or more alternate outbound mail servers
-if the default perl.org mail servers cannot be reached; multiple servers may be
-given, separated with a space (none by default)
-
-In at least one reported case, an ISP's outbound mail servers also refused
-to forward mail unless the {email_from} was from the ISP-given email address.
-
-== Action Prompts
-
-Several steps in the generation of a test report are optional. Configuration
-options control whether an action should be taken automatically or whether
-CPAN::Reporter should prompt the user for the action to take. The action
-to take may be different for each report grade.
-
-Valid actions, and their associated meaning, are as follows:
-
-* {yes} -- automatic yes
-* {no} -- automatic no
-* {ask/no} or just {ask} -- ask each time, but default to no
-* {ask/yes} -- ask each time, but default to yes
-
-For "ask" prompts, the default will be used if return is pressed immediately at
-the prompt or if the {PERL_MM_USE_DEFAULT} environment variable is set to a
-true value.
-
-Action prompt options take one or more space-separated "grade:action" pairs,
-which are processed left to right.
-
- edit_report = fail:ask/yes pass:no
-
-An action by itself is taken as a default to be used for any grade which does
-not have a grade-specific action. A default action may also be set by using
-the word "default" in place of a grade.
-
- edit_report = ask/no
- edit_report = default:ask/no
-
-A grade by itself is taken to have the action "yes" for that grade.
-
- edit_report = default:no fail
-
-Multiple grades may be specified together by separating them with a slash.
-
- edit_report = pass:no fail/na/unknown:ask/yes
-
-The action prompt options included in interactive configuration are:
-
-* {edit_report = <grade:action> ...} -- edit the test report before sending?
-(default:ask/no pass/na:no)
-* {send_report = <grade:action> ...} -- should test reports be sent at all?
-(default:ask/yes pass/na:yes)
-
-Note that if {send_report} is set to "no", CPAN::Reporter will still go through
-the motions of preparing a report, but will discard it rather than send it.
-
-A better way to disable CPAN::Reporter temporarily is with the CPAN option
-{test_report}:
-
- cpan> o conf test_report 0
-
-= ADVANCED CONFIGURATION OPTIONS
-
-These additional options are only necessary in special cases, for example if
-the default editor cannot be found or if reports shouldn't be sent in
-certain situations or for automated testing, and so on.
-
-* {cc_author = <grade:action> ...} -- should module authors should be sent a
-copy of the test report at their {author@cpan.org} address?
-(default:yes pass/na:no)
-* {cc_skipfile = <skipfile>} -- filename containing regular expressions (one
-per line) to match against the distribution ID (e.g.
-'AUTHOR/Dist-Name-0.01.tar.gz'); the author will not be copied if a match is
-found regardless of cc_author; non-absolute filename must be in the .cpanreporter
-config directory;
-* {command_timeout} -- if greater than zero and the CPAN config is
-{inactivity_timeout} is not set, then any commands executed by CPAN::Reporter
-will be halted after this many seconds; useful for unattended smoke testing
-to stop after some amount of time; generally, this should be large --
-900 seconds or more -- as some distributions' tests take quite a long time to
-run. On MSWin32, [Win32::Job] is a needed and trying to kill a processes may
-actually deadlock in some situations -- so use at your own risk
-* {editor = <editor>} -- editor to use to edit the test report; if not set,
-Test::Reporter will use environment variables {VISUAL}, {EDITOR} or {EDIT}
-(in that order) to find an editor
-* {send_duplicates = <grade:action> ...} -- should duplicates of previous
-reports be sent, regardless of {send_report}? (default:no)
-* {send_PL_report = <grade:action> ...} -- if defined, used in place of
-{send_report} during the PL phase
-* {send_make_report = <grade:action> ...} -- if defined, used in place of
-{send_report} during the make phase
-* {send_test_report = <grade:action> ...} -- if defined, used in place of
-{send_report} during the test phase
-* {send_skipfile = <skipfile>} -- like {cc_skipfile} but no report will be
-sent at all if a match is found
-* {transport = <transport>} -- if defined, passed to the {transport()}
-method of [Test::Reporter]. Valid options are 'Net::SMTP' or
-'Mail::Send'. (CPAN::Reporter uses Net::SMTP for this by default.)
-
-If these options are manually added to the configuration file, they will
-be included (and preserved) in subsequent interactive configuration.
-
-== Skipfile regular expressions
-
-Skip files are expected to have one regular expression per line and will be
-matched against the distribution ID, composed of the author's CPAN ID and the
-distribution tarball name.
-
- DAGOLDEN/CPAN-Reporter-1.00.tar.gz
-
-Lines that begin with a sharp (#) are considered comments and will not be
-matched. All regular expressionss will be matched case insensitive and will
-not be anchored unless you provide one.
-
-As the format of a distribution ID is "AUTHOR/tarball", anchoring at the
-start of the line with a caret (^) will match the author and with a slash (/)
-will match the distribution.
-
- # any distributions by JOHNDOE
- ^JOHNDOE
- # any distributions starting with Win32
- /Win32
- # a particular very specific distribution
- ^JOHNDOE/Foo-Bar-3.14
-
-= CONFIGURATION OPTIONS FOR DEBUGGING
-
-These options are useful for debugging only:
-
-* {debug = <boolean>} -- turns debugging on/off
-* {email_to = <email address>} -- alternate destination for reports instead of
-{cpan-testers@perl.org}; used for testing
-
-= ENVIRONMENT
-
-The following environment variables may be set to alter the default locations
-for CPAN::Reporter files:
-
-* {PERL_CPAN_REPORTER_DIR} -- if set, this directory is used in place of
-the default .cpanreporter directory; this will affect not only the location
-of the default {config.ini}, but also the location of the
-[CPAN::Reporter::History] database and any other files that live in that
-directory
-* {PERL_CPAN_REPORTER_CONFIG} -- if set, this file is used in place of
-the default {config.ini} file; it may be in any directory, regardless of the
-choice of configuration directory
-
-= SEE ALSO
-
-* [CPAN::Reporter]
-* [CPAN::Reporter::History]
-* [CPAN::Reporter::FAQ]
-
-= AUTHOR
-
-David A. Golden (DAGOLDEN)
-
-= COPYRIGHT AND LICENSE
-
-Copyright (c) 2006, 2007, 2008 by David A. Golden
-
-Licensed under the Apache License, Version 2.0 (the "License");
-you may not use this file except in compliance with the License.
-You may obtain a copy of the License at
-[http://www.apache.org/licenses/LICENSE-2.0]
-
-Unless required by applicable law or agreed to in writing, software
-distributed under the License is distributed on an "AS IS" BASIS,
-WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-See the License for the specific language governing permissions and
-limitations under the License.
-
-
-=end wikidoc
-
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/CPAN/Reporter/Config.pod b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/CPAN/Reporter/Config.pod
deleted file mode 100644
index 12b1805a899..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/CPAN/Reporter/Config.pod
+++ /dev/null
@@ -1,342 +0,0 @@
-# Generated by Pod::WikiDoc version 0.18
-
-=pod
-
-=head1 NAME
-
-CPAN::Reporter::Config - Config file options for CPAN::Reporter
-
-=head1 VERSION
-
-This documentation refers to version 1.13
-
-=head1 SYNOPSIS
-
-From the CPAN shell:
-
- cpan> o conf init test_report
-
-=head1 DESCRIPTION
-
-Default options for CPAN::Reporter are read from a configuration file
-C<<< .cpanreporter/config.ini >>> in the user's home directory (Unix and OS X)
-or "My Documents" directory (Windows).
-
-The configuration file is in "ini" format, with the option name and value
-separated by an "=" sign
-
- email_from = "John Doe" <johndoe@nowhere.org>
- cc_author = no
-
-Interactive configuration of email address, mail server and common
-action prompts may be repeated at any time from the CPAN shell.
-
- cpan> o conf init test_report
-
-If a configuration file does not exist, it will be created the first
-time interactive configuration is performed.
-
-Subsequent interactive configuration will also include any advanced
-options that have been added manually to the configuration file.
-
-=head1 INTERACTIVE CONFIGURATION OPTIONS
-
-=head2 Email Address (required)
-
-CPAN::Reporter requires users to provide an email address that will be used
-in the "From" header of the email to cpan-testers@perl.org.
-
-=over
-
-=item *
-
-C<<< email_from = <email address> >>> -- email address of the user sending the
-test report; it should be a valid address format, e.g.:
-
-=back
-
- user@domain
- John Doe <user@domain>
- "John Q. Public" <user@domain>
-
-Because C<<< cpan-testers >>> uses a mailing list to collect test reports, it is
-helpful if the email address provided is subscribed to the list. Otherwise,
-test reports will be held until manually reviewed and approved.
-
-Subscribing an account to the cpan-testers list is as easy as sending a blank
-email to cpan-testers-subscribe@perl.org and replying to the confirmation
-email.
-
-=head2 Mail Server
-
-By default, Test::Reporter attempts to send mail directly to perl.org mail
-servers. This may fail if a user's computer is behind a network firewall
-that blocks outbound email. In this case, the following option should
-be set to the outbound mail server (i.e., SMTP server) as provided by
-the user's Internet service provider (ISP):
-
-=over
-
-=item *
-
-C<<< smtp_server = <server list> >>> -- one or more alternate outbound mail servers
-if the default perl.org mail servers cannot be reached; multiple servers may be
-given, separated with a space (none by default)
-
-=back
-
-In at least one reported case, an ISP's outbound mail servers also refused
-to forward mail unless the C<<< email_from >>> was from the ISP-given email address.
-
-=head2 Action Prompts
-
-Several steps in the generation of a test report are optional. Configuration
-options control whether an action should be taken automatically or whether
-CPAN::Reporter should prompt the user for the action to take. The action
-to take may be different for each report grade.
-
-Valid actions, and their associated meaning, are as follows:
-
-=over
-
-=item *
-
-C<<< yes >>> -- automatic yes
-
-=item *
-
-C<<< no >>> -- automatic no
-
-=item *
-
-C<<< ask/no >>> or just C<<< ask >>> -- ask each time, but default to no
-
-=item *
-
-C<<< ask/yes >>> -- ask each time, but default to yes
-
-=back
-
-For "ask" prompts, the default will be used if return is pressed immediately at
-the prompt or if the C<<< PERL_MM_USE_DEFAULT >>> environment variable is set to a
-true value.
-
-Action prompt options take one or more space-separated "grade:action" pairs,
-which are processed left to right.
-
- edit_report = fail:ask/yes pass:no
-
-An action by itself is taken as a default to be used for any grade which does
-not have a grade-specific action. A default action may also be set by using
-the word "default" in place of a grade.
-
- edit_report = ask/no
- edit_report = default:ask/no
-
-A grade by itself is taken to have the action "yes" for that grade.
-
- edit_report = default:no fail
-
-Multiple grades may be specified together by separating them with a slash.
-
- edit_report = pass:no fail/na/unknown:ask/yes
-
-The action prompt options included in interactive configuration are:
-
-=over
-
-=item *
-
-C<<< edit_report = <grade:action> ... >>> -- edit the test report before sending?
-(default:askE<sol>no passE<sol>na:no)
-
-=item *
-
-C<<< send_report = <grade:action> ... >>> -- should test reports be sent at all?
-(default:askE<sol>yes passE<sol>na:yes)
-
-=back
-
-Note that if C<<< send_report >>> is set to "no", CPAN::Reporter will still go through
-the motions of preparing a report, but will discard it rather than send it.
-
-A better way to disable CPAN::Reporter temporarily is with the CPAN option
-C<<< test_report >>>:
-
- cpan> o conf test_report 0
-
-=head1 ADVANCED CONFIGURATION OPTIONS
-
-These additional options are only necessary in special cases, for example if
-the default editor cannot be found or if reports shouldn't be sent in
-certain situations or for automated testing, and so on.
-
-=over
-
-=item *
-
-C<<< cc_author = <grade:action> ... >>> -- should module authors should be sent a
-copy of the test report at their C<<< author@cpan.org >>> address?
-(default:yes passE<sol>na:no)
-
-=item *
-
-C<<< cc_skipfile = <skipfile> >>> -- filename containing regular expressions (one
-per line) to match against the distribution ID (e.g.
-'AUTHORE<sol>Dist-Name-0.01.tar.gz'); the author will not be copied if a match is
-found regardless of cc_author; non-absolute filename must be in the .cpanreporter
-config directory;
-
-=item *
-
-C<<< command_timeout >>> -- if greater than zero and the CPAN config is
-C<<< inactivity_timeout >>> is not set, then any commands executed by CPAN::Reporter
-will be halted after this many seconds; useful for unattended smoke testing
-to stop after some amount of time; generally, this should be large --
-900 seconds or more -- as some distributions' tests take quite a long time to
-run. On MSWin32, L<Win32::Job> is a needed and trying to kill a processes may
-actually deadlock in some situations -- so use at your own risk
-
-=item *
-
-C<<< editor = <editor> >>> -- editor to use to edit the test report; if not set,
-Test::Reporter will use environment variables C<<< VISUAL >>>, C<<< EDITOR >>> or C<<< EDIT >>>
-(in that order) to find an editor
-
-=item *
-
-C<<< send_duplicates = <grade:action> ... >>> -- should duplicates of previous
-reports be sent, regardless of C<<< send_report >>>? (default:no)
-
-=item *
-
-C<<< send_PL_report = <grade:action> ... >>> -- if defined, used in place of
-C<<< send_report >>> during the PL phase
-
-=item *
-
-C<<< send_make_report = <grade:action> ... >>> -- if defined, used in place of
-C<<< send_report >>> during the make phase
-
-=item *
-
-C<<< send_test_report = <grade:action> ... >>> -- if defined, used in place of
-C<<< send_report >>> during the test phase
-
-=item *
-
-C<<< send_skipfile = <skipfile> >>> -- like C<<< cc_skipfile >>> but no report will be
-sent at all if a match is found
-
-=item *
-
-C<<< transport = <transport> >>> -- if defined, passed to the C<<< transport() >>>
-method of L<Test::Reporter>. Valid options are 'Net::SMTP' or
-'Mail::Send'. (CPAN::Reporter uses Net::SMTP for this by default.)
-
-=back
-
-If these options are manually added to the configuration file, they will
-be included (and preserved) in subsequent interactive configuration.
-
-=head2 Skipfile regular expressions
-
-Skip files are expected to have one regular expression per line and will be
-matched against the distribution ID, composed of the author's CPAN ID and the
-distribution tarball name.
-
- DAGOLDEN/CPAN-Reporter-1.00.tar.gz
-
-Lines that begin with a sharp (#) are considered comments and will not be
-matched. All regular expressionss will be matched case insensitive and will
-not be anchored unless you provide one.
-
-As the format of a distribution ID is "AUTHORE<sol>tarball", anchoring at the
-start of the line with a caret (^) will match the author and with a slash (E<sol>)
-will match the distribution.
-
- # any distributions by JOHNDOE
- ^JOHNDOE
- # any distributions starting with Win32
- /Win32
- # a particular very specific distribution
- ^JOHNDOE/Foo-Bar-3.14
-
-=head1 CONFIGURATION OPTIONS FOR DEBUGGING
-
-These options are useful for debugging only:
-
-=over
-
-=item *
-
-C<<< debug = <boolean> >>> -- turns debugging onE<sol>off
-
-=item *
-
-C<<< email_to = <email address> >>> -- alternate destination for reports instead of
-C<<< cpan-testers@perl.org >>>; used for testing
-
-=back
-
-=head1 ENVIRONMENT
-
-The following environment variables may be set to alter the default locations
-for CPAN::Reporter files:
-
-=over
-
-=item *
-
-C<<< PERL_CPAN_REPORTER_DIR >>> -- if set, this directory is used in place of
-the default .cpanreporter directory; this will affect not only the location
-of the default C<<< config.ini >>>, but also the location of the
-L<CPAN::Reporter::History> database and any other files that live in that
-directory
-
-=item *
-
-C<<< PERL_CPAN_REPORTER_CONFIG >>> -- if set, this file is used in place of
-the default C<<< config.ini >>> file; it may be in any directory, regardless of the
-choice of configuration directory
-
-=back
-
-=head1 SEE ALSO
-
-=over
-
-=item *
-
-L<CPAN::Reporter>
-
-=item *
-
-L<CPAN::Reporter::History>
-
-=item *
-
-L<CPAN::Reporter::FAQ>
-
-=back
-
-=head1 AUTHOR
-
-David A. Golden (DAGOLDEN)
-
-=head1 COPYRIGHT AND LICENSE
-
-Copyright (c) 2006, 2007, 2008 by David A. Golden
-
-Licensed under the Apache License, Version 2.0 (the "License");
-you may not use this file except in compliance with the License.
-You may obtain a copy of the License at
-L<http://www.apache.org/licenses/LICENSE-2.0>
-
-Unless required by applicable law or agreed to in writing, software
-distributed under the License is distributed on an "AS IS" BASIS,
-WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-See the License for the specific language governing permissions and
-limitations under the License.
-
-
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/CPAN/Reporter/FAQ.pod b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/CPAN/Reporter/FAQ.pod
deleted file mode 100644
index 0db8105e12b..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/CPAN/Reporter/FAQ.pod
+++ /dev/null
@@ -1,138 +0,0 @@
-# Generated by Pod::WikiDoc version 0.18
-
-=pod
-
-=head1 NAME
-
-CPAN::Reporter::FAQ - Answers and tips for using CPAN::Reporter
-
-=head1 VERSION
-
-This documentation refers to version 1.13
-
-=head1 REPORT GRADES
-
-=head2 Why did I receive a report? The grade was PASSE<sol>FAILE<sol>UNKNOWNE<sol>NA!
-
-If you received a report, it's because the person using CPAN::Reporter
-chose to copy you on the report in addition to sending it to CPAN Testers.
-CPAN::Reporter suggests that only FAIL and UNKNOWN reports be copied to
-authors, but individual users may override that default.
-
-=head2 Why was a report sent if a prerequisite is missing?
-
-As of CPAN::Reporter 0.46, FAIL and UNKNOWN reports with unsatisfied
-prerequisites are discarded. Earlier versions may have sent these reports
-out by mistake as either an NA or UNKNOWN report.
-
-PASS reports are not discarded because it may be useful to know when tests
-passed despite a missing prerequisite. NA reports are sent because information
-about the lack of support for a platform is relevant regardless of
-prerequisites.
-
-=head1 SENDING REPORTS
-
-=head2 Why did I get an error sending a test report?
-
-Test reports are sent via ordinary email. The most common reason for errors
-sending a report is that many Internet Service Providers (ISP's) will block
-outbound SMTP (email) connections as part of their efforts to fight spam.
-Instead, email must be routed to the ISP's outbound mail servers, which will
-relay the email to the intended destination.
-
-You can configure CPAN::Reporter to use a specific outbound email server
-with the C<<< smtp_server >>> configuration option.
-
- smtp_server = mail.some-isp.com
-
-In at least one case, an ISP has blocked outbound email unless the
-"from" address was the assigned email address from that ISP.
-
-=head2 Why didn't my test report show up on CPAN Testers?
-
-CPAN Testers uses a mailing list to collect test reports. If the email
-address you set in C<<< email_from >>> is subscribed to the list, your emails
-will be automatically processed. Otherwise, test reports will be held
-until manually reviewed and approved.
-
-Subscribing an account to the cpan-testers list is as easy as sending a blank
-email to cpan-testers-subscribe@perl.org and replying to the confirmation
-email.
-
-There is a delay between the time emails appear on the mailing list and the
-time they appear on the CPAN Testers website. There is a further delay before
-summary statistics appear on search.cpan.org.
-
-If your email address is subscribed to the list but your test reports are still
-not showing up, your outbound email may have been silently blocked by your
-ISP. See the question above about errors sending reports.
-
-=head2 Why don't you support sending reports via HTTP or authenticated SMTP?
-
-CPAN::Reporter uses L<Test::Reporter> as its conduit to CPAN Testers.
-As soon as Test::Reporter provides support for alternative transport
-methods, support for them will be added to CPAN::Reporter.
-
-=head1 CPAN TESTERS
-
-=head2 Where can I find out more about CPAN Testers?
-
-A good place to start is the CPAN Testers Wiki:
-L<http://cpantest.grango.org/>
-
-=head2 Where can I find statistics about reports sent to CPAN Testers?
-
-CPAN Testers statistics are compiled at L<http://perl.grango.org/>
-
-=head2 How do I make sure I get credit for my test reports?
-
-To get credit in the statistics, use the same email address wherever
-you run tests.
-
-For example, if you are a CPAN author, use your PAUSEID email address.
-
- email_from = pauseid@cpan.org
-
-Otherwise, you should use a consistent "Full Name" as part of your
-email address in the C<<< email_from >>> option.
-
- email_from = "John Doe" <john.doe@example.com>
-
-=head1 SEE ALSO
-
-=over
-
-=item *
-
-L<CPAN::Testers>
-
-=item *
-
-L<CPAN::Reporter>
-
-=item *
-
-L<Test::Reporter>
-
-=back
-
-=head1 AUTHOR
-
-David A. Golden (DAGOLDEN)
-
-=head1 COPYRIGHT AND LICENSE
-
-Copyright (c) 2006, 2007, 2008 by David A. Golden
-
-Licensed under the Apache License, Version 2.0 (the "License");
-you may not use this file except in compliance with the License.
-You may obtain a copy of the License at
-L<http://www.apache.org/licenses/LICENSE-2.0>
-
-Unless required by applicable law or agreed to in writing, software
-distributed under the License is distributed on an "AS IS" BASIS,
-WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-See the License for the specific language governing permissions and
-limitations under the License.
-
-
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/CPAN/Reporter/History.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/CPAN/Reporter/History.pm
deleted file mode 100644
index fac11ad0348..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/CPAN/Reporter/History.pm
+++ /dev/null
@@ -1,404 +0,0 @@
-package CPAN::Reporter::History;
-use strict;
-use vars qw/$VERSION @ISA @EXPORT_OK/;
-$VERSION = '1.13';
-$VERSION = eval $VERSION;
-
-use Config;
-use Carp;
-use Fcntl qw/:flock/;
-use File::HomeDir ();
-use File::Path (qw/mkpath/);
-use File::Spec ();
-use IO::File ();
-use CPAN (); # for printing warnings
-use CPAN::Reporter::Config ();
-
-require Exporter;
-@ISA = qw/Exporter/;
-@EXPORT_OK = qw/have_tested/;
-
-#--------------------------------------------------------------------------#
-# Some platforms don't implement flock, so fake it if necessary
-#--------------------------------------------------------------------------#
-
-BEGIN {
- eval {
- my $temp_file = File::Spec->catfile(
- File::Spec->tmpdir(), $$ . time()
- );
- my $fh = IO::File->new( $temp_file, "w" );
- flock $fh, LOCK_EX;
- $fh->close;
- unlink $temp_file;
- };
- if ( $@ ) {
- *CORE::GLOBAL::flock = sub (*$) { 1 };
- }
-}
-
-#--------------------------------------------------------------------------#
-# Back-compatibility checks -- just once per load
-#--------------------------------------------------------------------------#
-
-
-# 0.99_08 changed the history file format and name
-# If an old file exists, convert it to the new name and format. Note --
-# someone running multiple installations of CPAN::Reporter might have old
-# and new versions running so only convert in the case where the old file
-# exists and the new file does not
-
-{
- my $old_history_file = _get_old_history_file();
- my $new_history_file = _get_history_file();
- last if -f $new_history_file || ! -f $old_history_file;
-
- $CPAN::Frontend->mywarn("CPAN::Reporter: Your history file is in an old format. Upgrading automatically.\n");
-
- # open old and new files
- my ($old_fh, $new_fh);
- if (! ( $old_fh = IO::File->new( $old_history_file ) ) ) {
- $CPAN::Frontend->mywarn("CPAN::Reporter: error opening old history file: $!\nContinuing without conversion.\n");
- last;
- }
- if (! ($new_fh = IO::File->new( $new_history_file, "w" ) ) ) {
- $CPAN::Frontend->mywarn("CPAN::Reporter: error opening new history file: $!\nContinuing without conversion.\n");
- last;
- }
-
- print {$new_fh} "# Generated by CPAN::Reporter " .
- "$CPAN::Reporter::Config::VERSION\n";
- while ( my $line = <$old_fh> ) {
- chomp $line;
- # strip off perl version and convert
- # try not to match 5.1 from "MSWin32-x86-multi-thread 5.1"
- # from really old CPAN::Reporter history formats
- my ($old_version, $perl_patch);
- if ( $line =~ m{ (5\.0\d{2,5}) ?(patch \d+)?\z} ) {
- ($old_version, $perl_patch) = ($1, $2);
- $line =~ s{ (5\.0\d{2,5}) ?(patch \d+)?\z}{};
- }
- my $pv = $old_version ? "perl-" . _perl_version($old_version)
- : "unknown";
- $pv .= " $perl_patch" if $perl_patch;
- my ($grade_dist, $arch_os) = ($line =~ /(\S+ \S+) (.+)/);
- print {$new_fh} "test $grade_dist ($pv) $arch_os\n";
- }
- close $old_fh;
- close $new_fh;
-}
-
-
-#--------------------------------------------------------------------------#
-# Public methods
-#--------------------------------------------------------------------------#
-
-#--------------------------------------------------------------------------#
-# have_tested -- search for dist in history file
-#--------------------------------------------------------------------------#
-
-sub have_tested { ## no critic RequireArgUnpacking
- # validate arguments
- croak "arguments to have_tested() must be key value pairs"
- if @_ % 2;
-
- my $args = { @_ };
-
- my @bad_params = grep {
- $_ !~ m{^(?:dist|phase|grade|perl|archname|osvers)$} } keys %$args;
- croak "bad parameters for have_tested(): " . join(q{, },@bad_params)
- if @bad_params;
-
-
- # DWIM: grades to upper case
- $args->{grade} = uc $args->{grade} if defined $args->{grade};
-
- # default to current platform
- $args->{perl} = _format_perl_version() unless defined $args->{perl};
- $args->{archname} = $Config{archname} unless defined $args->{archname};
- $args->{osvers} = $Config{osvers} unless defined $args->{osvers};
-
- my @found;
- my $history = _open_history_file('<') or return;
- flock $history, LOCK_SH;
- <$history>; # throw away format line
- while ( defined (my $line = <$history>) ) {
- my $fields = _split_history( $line ) or next;
- push @found, $fields if _match($fields, $args);
- }
- $history->close;
- return @found;
-}
-
-#--------------------------------------------------------------------------#
-# Private methods
-#--------------------------------------------------------------------------#
-
-#--------------------------------------------------------------------------#
-# _format_history --
-#
-# phase grade dist-version (perl-version patchlevel) archname osvers
-#--------------------------------------------------------------------------#
-
-sub _format_history {
- my ($result) = @_;
- my $phase = $result->{phase};
- my $grade = uc $result->{grade};
- my $dist_name = $result->{dist_name};
- my $perlver = "perl-" . _format_perl_version();
- my $platform = "$Config{archname} $Config{osvers}";
- return "$phase $grade $dist_name ($perlver) $platform\n";
-}
-
-#--------------------------------------------------------------------------#
-# _format_perl_version
-#--------------------------------------------------------------------------#
-
-sub _format_perl_version {
- my $pv = _perl_version();
- $pv .= " patch $Config{perl_patchlevel}"
- if $Config{perl_patchlevel};
- return $pv;
-}
-
-#--------------------------------------------------------------------------#
-# _get_history_file
-#--------------------------------------------------------------------------#
-
-sub _get_history_file {
- return File::Spec->catdir(
- CPAN::Reporter::Config::_get_config_dir(), "reports-sent.db"
- );
-}
-
-#--------------------------------------------------------------------------#
-# _get_old_history_file -- prior to 0.99_08
-#--------------------------------------------------------------------------#
-
-sub _get_old_history_file {
- return File::Spec->catdir(
- CPAN::Reporter::Config::_get_config_dir(), "history.db"
- );
-}
-
-#--------------------------------------------------------------------------#
-# _is_duplicate
-#--------------------------------------------------------------------------#
-
-sub _is_duplicate {
- my ($result) = @_;
- my $log_line = _format_history( $result );
- my $history = _open_history_file('<') or return;
- my $found = 0;
- flock $history, LOCK_SH;
- while ( defined (my $line = <$history>) ) {
- if ( $line eq $log_line ) {
- $found++;
- last;
- }
- }
- $history->close;
- return $found;
-}
-
-#--------------------------------------------------------------------------#
-# _match
-#--------------------------------------------------------------------------#
-
-sub _match {
- my ($fields, $search) = @_;
- for my $k ( keys %$search ) {
- next if $search->{$k} eq q{}; # empty string matches anything
- return unless $fields->{$k} eq $search->{$k};
- }
- return 1; # all keys matched
-}
-
-#--------------------------------------------------------------------------#
-# _open_history_file
-#--------------------------------------------------------------------------#
-
-sub _open_history_file {
- my $mode = shift || '<';
- my $history_filename = _get_history_file();
- my $file_exists = -f $history_filename;
-
- # shortcut if reading and doesn't exist
- return if ( $mode eq '<' && ! $file_exists );
-
- # open it in the desired mode
- my $history = IO::File->new( $history_filename, $mode )
- or $CPAN::Frontend->mywarn("CPAN::Reporter: couldn't open history file "
- . "'$history_filename': $!\n");
-
- # if writing and it didn't exist before, initialize with header
- if ( substr($mode,0,1) eq '>' && ! $file_exists ) {
- print {$history} "# Generated by CPAN::Reporter " .
- "$CPAN::Reporter::Config::VERSION\n";
- }
-
- return $history;
-}
-
-#--------------------------------------------------------------------------#
-# _perl_version
-#--------------------------------------------------------------------------#
-
-sub _perl_version {
- my $ver = shift || "$]";
- $ver =~ qr/(\d)\.(\d{3})(\d{0,3})/;
- my ($maj,$min,$pat) = (0 + ($1||0), 0 + ($2||0), 0 + ($3||0));
- my $pv;
- if ( $min < 6 ) {
- $pv = $ver;
- }
- else {
- $pv = "$maj\.$min\.$pat";
- }
- return $pv;
-}
-
-#--------------------------------------------------------------------------#
-# _record_history
-#--------------------------------------------------------------------------#
-
-sub _record_history {
- my ($result) = @_;
- my $log_line = _format_history( $result );
- my $history = _open_history_file('>>') or return;
-
- flock( $history, LOCK_EX );
- seek( $history, 0, 2 ); # seek to end of file
- $history->print( $log_line );
- flock( $history, LOCK_UN );
-
- $history->close;
- return;
-}
-
-#--------------------------------------------------------------------------#
-# _split_history
-#
-# splits lines created with _format_history. Returns hash ref with
-# phase, grade, dist, perl, platform
-#--------------------------------------------------------------------------#
-
-sub _split_history {
- my ($line) = @_;
- chomp $line;
- my %fields;
- @fields{qw/phase grade dist perl archname osvers/} =
- $line =~ m{
- ^(\S+) \s+ # phase
- (\S+) \s+ # grade
- (\S+) \s+ # dist
- \(perl- ([^)]+) \) \s+ # (perl-version-patchlevel)
- (\S+) \s+ # archname
- (.+)$ # osvers
- }xms;
-
- # return nothing if parse fails
- return if scalar keys %fields == 0;# grep { ! defined($_) } values %fields;
- # otherwise return hashref
- return \%fields;
-}
-
-1;
-__END__
-
-=begin wikidoc
-
-= NAME
-
-CPAN::Reporter::History - Read or write a CPAN::Reporter history log
-
-= VERSION
-
-This documentation refers to version %%VERSION%%
-
-= SYNOPSIS
-
- use CPAN::Reporter::History 'have_tested';
-
- @results = have_tested( dist => 'Dist-Name-1.23' );
-
-= DESCRIPTION
-
-Interface for interacting with the CPAN::Reporter history file. Most methods
-are private for use only within CPAN::Reporter itself. However, a public
-function is provided to query the history file for results.
-
-= USAGE
-
-The following function is available. It is not exported by default.
-
-== {have_tested()}
-
- # all reports for Foo-Bar-1.23
- @results = have_tested( dist => 'Foo-Bar-1.23' );
-
- # all NA reports
- @results = have_tested( grade => 'NA' );
-
- # all reports on the current Perl/platform
- @results = have_tested();
-
-Searches the CPAN::Reporter history file for records exactly matching search
-criteria, given as pairs of field-names and desired values.
-
-Ordinary search criteria include:
-
-* {dist} -- the distribution tarball name without any filename suffix; from
-a {CPAN::Distribution} object, this is provided by the {base_id} method.
-* {phase} -- phase the report was generated during: either 'PL',
-'make' or 'test'
-* {grade} -- CPAN Testers grade: 'PASS', 'FAIL', 'NA' or'UNKNOWN'; Also may
-be 'DISCARD' for any failing reports not sent due to missing prerequisites
-
-Without additional criteria, a search will be limited to the current
-version of Perl and the current architecture and OS version.
-Additional criteria may be specified explicitly or, by specifying the empty
-string, {q{}}, will match that field for ~any~ record.
-
- # all reports for Foo-Bar-1.23 on any version of perl
- # on the current architecture and OS version
- @results = have_tested( dist => 'Foo-Bar-1.23', perl => q{} );
-
-These additional criteria include:
-
-* {perl} -- perl version and possible patchlevel; this will be
-dotted decimal (5.6.2) starting with version 5.6, or will be numeric style as
-given by {$]} for older versions; if a patchlevel exists, it must be specified
-similar to "5.11.0 patch 12345"
-* {archname} -- platform architecture name as given by $Config{archname}
-* {osvers} -- operating system version as given by $Config{osvers}
-
-The function returns an array of hashes representing each test result, with
-all of the fields listed above.
-
-= SEE ALSO
-
-* [CPAN::Reporter]
-* [CPAN::Reporter::FAQ]
-
-= AUTHOR
-
-David A. Golden (DAGOLDEN)
-
-= COPYRIGHT AND LICENSE
-
-Copyright (c) 2006, 2007, 2008 by David A. Golden
-
-Licensed under the Apache License, Version 2.0 (the "License");
-you may not use this file except in compliance with the License.
-You may obtain a copy of the License at
-[http://www.apache.org/licenses/LICENSE-2.0]
-
-Unless required by applicable law or agreed to in writing, software
-distributed under the License is distributed on an "AS IS" BASIS,
-WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-See the License for the specific language governing permissions and
-limitations under the License.
-
-=end wikidoc
-
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/CPAN/Reporter/History.pod b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/CPAN/Reporter/History.pod
deleted file mode 100644
index 38dc36f2d78..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/CPAN/Reporter/History.pod
+++ /dev/null
@@ -1,130 +0,0 @@
-# Generated by Pod::WikiDoc version 0.18
-
-=pod
-
-=head1 NAME
-
-CPAN::Reporter::History - Read or write a CPAN::Reporter history log
-
-=head1 VERSION
-
-This documentation refers to version 1.13
-
-=head1 SYNOPSIS
-
- use CPAN::Reporter::History 'have_tested';
-
- @results = have_tested( dist => 'Dist-Name-1.23' );
-
-=head1 DESCRIPTION
-
-Interface for interacting with the CPAN::Reporter history file. Most methods
-are private for use only within CPAN::Reporter itself. However, a public
-function is provided to query the history file for results.
-
-=head1 USAGE
-
-The following function is available. It is not exported by default.
-
-=head2 C<<< have_tested() >>>
-
- # all reports for Foo-Bar-1.23
- @results = have_tested( dist => 'Foo-Bar-1.23' );
-
- # all NA reports
- @results = have_tested( grade => 'NA' );
-
- # all reports on the current Perl/platform
- @results = have_tested();
-
-Searches the CPAN::Reporter history file for records exactly matching search
-criteria, given as pairs of field-names and desired values.
-
-Ordinary search criteria include:
-
-=over
-
-=item *
-
-C<<< dist >>> -- the distribution tarball name without any filename suffix; from
-a C<<< CPAN::Distribution >>> object, this is provided by the C<<< base_id >>> method.
-
-=item *
-
-C<<< phase >>> -- phase the report was generated during: either 'PL',
-'make' or 'test'
-
-=item *
-
-C<<< grade >>> -- CPAN Testers grade: 'PASS', 'FAIL', 'NA' or'UNKNOWN'; Also may
-be 'DISCARD' for any failing reports not sent due to missing prerequisites
-
-=back
-
-Without additional criteria, a search will be limited to the current
-version of Perl and the current architecture and OS version.
-Additional criteria may be specified explicitly or, by specifying the empty
-string, C<<< q{} >>>, will match that field for I<any> record.
-
- # all reports for Foo-Bar-1.23 on any version of perl
- # on the current architecture and OS version
- @results = have_tested( dist => 'Foo-Bar-1.23', perl => q{} );
-
-These additional criteria include:
-
-=over
-
-=item *
-
-C<<< perl >>> -- perl version and possible patchlevel; this will be
-dotted decimal (5.6.2) starting with version 5.6, or will be numeric style as
-given by C<<< $] >>> for older versions; if a patchlevel exists, it must be specified
-similar to "5.11.0 patch 12345"
-
-=item *
-
-C<<< archname >>> -- platform architecture name as given by $Config{archname}
-
-=item *
-
-C<<< osvers >>> -- operating system version as given by $Config{osvers}
-
-=back
-
-The function returns an array of hashes representing each test result, with
-all of the fields listed above.
-
-=head1 SEE ALSO
-
-=over
-
-=item *
-
-L<CPAN::Reporter>
-
-=item *
-
-L<CPAN::Reporter::FAQ>
-
-=back
-
-=head1 AUTHOR
-
-David A. Golden (DAGOLDEN)
-
-=head1 COPYRIGHT AND LICENSE
-
-Copyright (c) 2006, 2007, 2008 by David A. Golden
-
-Licensed under the Apache License, Version 2.0 (the "License");
-you may not use this file except in compliance with the License.
-You may obtain a copy of the License at
-L<http://www.apache.org/licenses/LICENSE-2.0>
-
-Unless required by applicable law or agreed to in writing, software
-distributed under the License is distributed on an "AS IS" BASIS,
-WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-See the License for the specific language governing permissions and
-limitations under the License.
-
-
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/CPAN/Reporter/PrereqCheck.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/CPAN/Reporter/PrereqCheck.pm
deleted file mode 100644
index 356718f07c0..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/CPAN/Reporter/PrereqCheck.pm
+++ /dev/null
@@ -1,182 +0,0 @@
-package CPAN::Reporter::PrereqCheck;
-use strict;
-use vars qw/$VERSION/;
-$VERSION = '1.13';
-$VERSION = eval $VERSION;
-
-use ExtUtils::MakeMaker;
-use File::Spec;
-use CPAN::Version;
-
-_run() if ! caller();
-
-sub _run {
- my %saw_mod;
- # read module and prereq string from STDIN
- local *DEVNULL;
- open DEVNULL, ">" . File::Spec->devnull;
- while ( <> ) {
- m/^(\S+)\s+([^\n]*)/;
- my ($mod, $need) = ($1, $2);
- die "Couldn't read module for '$_'" unless $mod;
- $need = 0 if not defined $need;
-
- # only evaluate a module once
- next if $saw_mod{$mod}++;
-
- # get installed version from file with EU::MM
- my($have, $inst_file, $dir, @packpath);
- if ( $mod eq "perl" ) {
- $have = $];
- }
- else {
- @packpath = split( /::/, $mod );
- $packpath[-1] .= ".pm";
- if (@packpath == 1 && $packpath[0] eq "readline.pm") {
- unshift @packpath, "Term", "ReadLine"; # historical reasons
- }
- INCDIR:
- foreach my $dir (@INC) {
- my $pmfile = File::Spec->catfile($dir,@packpath);
- if (-f $pmfile){
- $inst_file = $pmfile;
- last INCDIR;
- }
- }
-
- # get version from file or else report missing
- if ( defined $inst_file ) {
- $have = MM->parse_version($inst_file);
- $have = "0" if ! defined $have || $have eq 'undef';
- # report broken if it can't be loaded
- select DEVNULL; # try to suppress spurious newlines
- if ( ! eval "require $mod" ) {
- select STDOUT;
- print "$mod 0 broken\n";
- next;
- }
- select STDOUT;
- }
- else {
- print "$mod 0 n/a\n";
- next;
- }
- }
-
- # complex requirements are comma separated
- my ( @requirements ) = split /\s*,\s*/, $need;
-
- my $passes = 0;
- RQ:
- for my $rq (@requirements) {
- if ($rq =~ s|>=\s*||) {
- # no-op -- just trimmed string
- } elsif ($rq =~ s|>\s*||) {
- if (CPAN::Version->vgt($have,$rq)){
- $passes++;
- }
- next RQ;
- } elsif ($rq =~ s|!=\s*||) {
- if (CPAN::Version->vcmp($have,$rq)) {
- $passes++; # didn't match
- }
- next RQ;
- } elsif ($rq =~ s|<=\s*||) {
- if (! CPAN::Version->vgt($have,$rq)){
- $passes++;
- }
- next RQ;
- } elsif ($rq =~ s|<\s*||) {
- if (CPAN::Version->vlt($have,$rq)){
- $passes++;
- }
- next RQ;
- }
- # if made it here, then it's a normal >= comparison
- if (! CPAN::Version->vlt($have, $rq)){
- $passes++;
- }
- }
- my $ok = $passes == @requirements ? 1 : 0;
- print "$mod $ok $have\n"
- }
- return;
-}
-
-1;
-
-__END__
-
-#--------------------------------------------------------------------------#
-# pod documentation
-#--------------------------------------------------------------------------#
-
-=begin wikidoc
-
-= NAME
-
-CPAN::Reporter::PrereqCheck - Modulino for prerequisite tests
-
-= VERSION
-
-This documentation describes version %%VERSION%%.
-
-= SYNOPSIS
-
- require CPAN::Reporter::PrereqCheck;
- my $prereq_check = $INC{'CPAN/Reporter/PrereqCheck.pm'};
- my $result = qx/$perl $prereq_check < $prereq_file/;
-
-= DESCRIPTION
-
-This modulino determines whether a list of prerequisite modules are
-available and, if so, their version number. It is designed to be run
-as a script in order to provide this information from the perspective of
-a subprocess, just like CPAN::Reporter's invocation of {perl Makefile.PL}
-and so on.
-
-It reads a module name and prerequisite string pair from each line of input
-and prints out the module name, 0 or 1 depending on whether the prerequisite
-is satisifed, and the installed module version. If the module is not
-available, it will print "n/a" for the version. If the module is available
-but can't be loaded, it will print "broken" for the version. Modules
-without a version will be treated as being of version "0".
-
-No user serviceable parts are inside. This modulino is packaged for
-internal use by CPAN::Reporter.
-
-= BUGS
-
-Please report any bugs or feature using the CPAN Request Tracker.
-Bugs can be submitted through the web interface at
-[http://rt.cpan.org/Dist/Display.html?Queue=CPAN-Reporter]
-
-When submitting a bug or request, please include a test-file or a patch to an
-existing test-file that illustrates the bug or desired feature.
-
-= SEE ALSO
-
-* [CPAN::Reporter] -- main documentation
-
-= AUTHOR
-
-David A. Golden (DAGOLDEN)
-
-= COPYRIGHT AND LICENSE
-
-Copyright (c) 2006, 2007 by David A. Golden
-
-Licensed under the Apache License, Version 2.0 (the "License");
-you may not use this file except in compliance with the License.
-You may obtain a copy of the License at
-[http://www.apache.org/licenses/LICENSE-2.0]
-
-Unless required by applicable law or agreed to in writing, software
-distributed under the License is distributed on an "AS IS" BASIS,
-WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-See the License for the specific language governing permissions and
-limitations under the License.
-
-=end wikidoc
-
-=cut
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/CPAN/Reporter/PrereqCheck.pod b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/CPAN/Reporter/PrereqCheck.pod
deleted file mode 100644
index 088507a60ac..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/CPAN/Reporter/PrereqCheck.pod
+++ /dev/null
@@ -1,75 +0,0 @@
-# Generated by Pod::WikiDoc version 0.18
-
-=pod
-
-=head1 NAME
-
-CPAN::Reporter::PrereqCheck - Modulino for prerequisite tests
-
-=head1 VERSION
-
-This documentation describes version 1.13.
-
-=head1 SYNOPSIS
-
- require CPAN::Reporter::PrereqCheck;
- my $prereq_check = $INC{'CPAN/Reporter/PrereqCheck.pm'};
- my $result = qx/$perl $prereq_check < $prereq_file/;
-
-=head1 DESCRIPTION
-
-This modulino determines whether a list of prerequisite modules are
-available and, if so, their version number. It is designed to be run
-as a script in order to provide this information from the perspective of
-a subprocess, just like CPAN::Reporter's invocation of C<<< perl Makefile.PL >>>
-and so on.
-
-It reads a module name and prerequisite string pair from each line of input
-and prints out the module name, 0 or 1 depending on whether the prerequisite
-is satisifed, and the installed module version. If the module is not
-available, it will print "nE<sol>a" for the version. If the module is available
-but can't be loaded, it will print "broken" for the version. Modules
-without a version will be treated as being of version "0".
-
-No user serviceable parts are inside. This modulino is packaged for
-internal use by CPAN::Reporter.
-
-=head1 BUGS
-
-Please report any bugs or feature using the CPAN Request Tracker.
-Bugs can be submitted through the web interface at
-L<http://rt.cpan.org/Dist/Display.html?Queue=CPAN-Reporter>
-
-When submitting a bug or request, please include a test-file or a patch to an
-existing test-file that illustrates the bug or desired feature.
-
-=head1 SEE ALSO
-
-=over
-
-=item *
-
-L<CPAN::Reporter> -- main documentation
-
-=back
-
-=head1 AUTHOR
-
-David A. Golden (DAGOLDEN)
-
-=head1 COPYRIGHT AND LICENSE
-
-Copyright (c) 2006, 2007 by David A. Golden
-
-Licensed under the Apache License, Version 2.0 (the "License");
-you may not use this file except in compliance with the License.
-You may obtain a copy of the License at
-L<http://www.apache.org/licenses/LICENSE-2.0>
-
-Unless required by applicable law or agreed to in writing, software
-distributed under the License is distributed on an "AS IS" BASIS,
-WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-See the License for the specific language governing permissions and
-limitations under the License.
-
-
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/CPAN/Tarzip.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/CPAN/Tarzip.pm
deleted file mode 100644
index a9cad247271..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/CPAN/Tarzip.pm
+++ /dev/null
@@ -1,352 +0,0 @@
-# -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*-
-package CPAN::Tarzip;
-use strict;
-use vars qw($VERSION @ISA $BUGHUNTING);
-use CPAN::Debug;
-use File::Basename ();
-$VERSION = sprintf "%.6f", substr(q$Rev: 2213 $,4)/1000000 + 5.4;
-# module is internal to CPAN.pm
-
-@ISA = qw(CPAN::Debug);
-$BUGHUNTING ||= 0; # released code must have turned off
-
-# it's ok if file doesn't exist, it just matters if it is .gz or .bz2
-sub new {
- my($class,$file) = @_;
- $CPAN::Frontend->mydie("CPAN::Tarzip->new called without arg") unless defined $file;
- if (0) {
- # nonono, we get e.g. 01mailrc.txt uncompressed if only wget is available
- $CPAN::Frontend->mydie("file[$file] doesn't match /\\.(bz2|gz|zip|tgz)\$/")
- unless $file =~ /\.(bz2|gz|zip|tgz)$/i;
- }
- my $me = { FILE => $file };
- if (0) {
- } elsif ($file =~ /\.bz2$/i) {
- unless ($me->{UNGZIPPRG} = $CPAN::Config->{bzip2}) {
- my $bzip2;
- if ($CPAN::META->has_inst("File::Which")) {
- $bzip2 = File::Which::which("bzip2");
- }
- if ($bzip2) {
- $me->{UNGZIPPRG} = $bzip2 || "bzip2";
- } else {
- $CPAN::Frontend->mydie(qq{
-CPAN.pm needs the external program bzip2 in order to handle '$file'.
-Please install it now and run 'o conf init' to register it as external
-program.
-});
- }
- }
- } else {
- # yes, we let gzip figure it out in *any* other case
- $me->{UNGZIPPRG} = $CPAN::Config->{gzip} || "gzip";
- }
- bless $me, $class;
-}
-
-sub gzip {
- my($self,$read) = @_;
- my $write = $self->{FILE};
- if ($CPAN::META->has_inst("Compress::Zlib")) {
- my($buffer,$fhw);
- $fhw = FileHandle->new($read)
- or $CPAN::Frontend->mydie("Could not open $read: $!");
- my $cwd = `pwd`;
- my $gz = Compress::Zlib::gzopen($write, "wb")
- or $CPAN::Frontend->mydie("Cannot gzopen $write: $! (pwd is $cwd)\n");
- $gz->gzwrite($buffer)
- while read($fhw,$buffer,4096) > 0 ;
- $gz->gzclose() ;
- $fhw->close;
- return 1;
- } else {
- my $command = CPAN::HandleConfig->safe_quote($self->{UNGZIPPRG});
- system(qq{$command -c "$read" > "$write"})==0;
- }
-}
-
-
-sub gunzip {
- my($self,$write) = @_;
- my $read = $self->{FILE};
- if ($CPAN::META->has_inst("Compress::Zlib")) {
- my($buffer,$fhw);
- $fhw = FileHandle->new(">$write")
- or $CPAN::Frontend->mydie("Could not open >$write: $!");
- my $gz = Compress::Zlib::gzopen($read, "rb")
- or $CPAN::Frontend->mydie("Cannot gzopen $read: $!\n");
- $fhw->print($buffer)
- while $gz->gzread($buffer) > 0 ;
- $CPAN::Frontend->mydie("Error reading from $read: $!\n")
- if $gz->gzerror != Compress::Zlib::Z_STREAM_END();
- $gz->gzclose() ;
- $fhw->close;
- return 1;
- } else {
- my $command = CPAN::HandleConfig->safe_quote($self->{UNGZIPPRG});
- system(qq{$command -dc "$read" > "$write"})==0;
- }
-}
-
-
-sub gtest {
- my($self) = @_;
- return $self->{GTEST} if exists $self->{GTEST};
- defined $self->{FILE} or $CPAN::Frontend->mydie("gtest called but no FILE specified");
- my $read = $self->{FILE};
- my $success;
- # After I had reread the documentation in zlib.h, I discovered that
- # uncompressed files do not lead to an gzerror (anymore?).
- if ( $CPAN::META->has_inst("Compress::Zlib") ) {
- my($buffer,$len);
- $len = 0;
- my $gz = Compress::Zlib::gzopen($read, "rb")
- or $CPAN::Frontend->mydie(sprintf("Cannot gzopen %s: %s\n",
- $read,
- $Compress::Zlib::gzerrno));
- while ($gz->gzread($buffer) > 0 ) {
- $len += length($buffer);
- $buffer = "";
- }
- my $err = $gz->gzerror;
- $success = ! $err || $err == Compress::Zlib::Z_STREAM_END();
- if ($len == -s $read) {
- $success = 0;
- CPAN->debug("hit an uncompressed file") if $CPAN::DEBUG;
- }
- $gz->gzclose();
- CPAN->debug("err[$err]success[$success]") if $CPAN::DEBUG;
- } else {
- my $command = CPAN::HandleConfig->safe_quote($self->{UNGZIPPRG});
- $success = 0==system(qq{$command -qdt "$read"});
- }
- return $self->{GTEST} = $success;
-}
-
-
-sub TIEHANDLE {
- my($class,$file) = @_;
- my $ret;
- $class->debug("file[$file]");
- my $self = $class->new($file);
- if (0) {
- } elsif (!$self->gtest) {
- my $fh = FileHandle->new($file)
- or $CPAN::Frontend->mydie("Could not open file[$file]: $!");
- binmode $fh;
- $self->{FH} = $fh;
- $class->debug("via uncompressed FH");
- } elsif ($CPAN::META->has_inst("Compress::Zlib")) {
- my $gz = Compress::Zlib::gzopen($file,"rb") or
- $CPAN::Frontend->mydie("Could not gzopen $file");
- $self->{GZ} = $gz;
- $class->debug("via Compress::Zlib");
- } else {
- my $gzip = CPAN::HandleConfig->safe_quote($self->{UNGZIPPRG});
- my $pipe = "$gzip -dc $file |";
- my $fh = FileHandle->new($pipe) or $CPAN::Frontend->mydie("Could not pipe[$pipe]: $!");
- binmode $fh;
- $self->{FH} = $fh;
- $class->debug("via external gzip");
- }
- $self;
-}
-
-
-sub READLINE {
- my($self) = @_;
- if (exists $self->{GZ}) {
- my $gz = $self->{GZ};
- my($line,$bytesread);
- $bytesread = $gz->gzreadline($line);
- return undef if $bytesread <= 0;
- return $line;
- } else {
- my $fh = $self->{FH};
- return scalar <$fh>;
- }
-}
-
-
-sub READ {
- my($self,$ref,$length,$offset) = @_;
- $CPAN::Frontend->mydie("read with offset not implemented") if defined $offset;
- if (exists $self->{GZ}) {
- my $gz = $self->{GZ};
- my $byteread = $gz->gzread($$ref,$length);# 30eaf79e8b446ef52464b5422da328a8
- return $byteread;
- } else {
- my $fh = $self->{FH};
- return read($fh,$$ref,$length);
- }
-}
-
-
-sub DESTROY {
- my($self) = @_;
- if (exists $self->{GZ}) {
- my $gz = $self->{GZ};
- $gz->gzclose() if defined $gz; # hard to say if it is allowed
- # to be undef ever. AK, 2000-09
- } else {
- my $fh = $self->{FH};
- $fh->close if defined $fh;
- }
- undef $self;
-}
-
-
-sub untar {
- my($self) = @_;
- my $file = $self->{FILE};
- my($prefer) = 0;
-
- if (0) { # makes changing order easier
- } elsif ($BUGHUNTING) {
- $prefer=2;
- } elsif (MM->maybe_command($self->{UNGZIPPRG})
- &&
- MM->maybe_command($CPAN::Config->{tar})) {
- # should be default until Archive::Tar handles bzip2
- $prefer = 1;
- } elsif (
- $CPAN::META->has_usable("Archive::Tar")
- &&
- $CPAN::META->has_inst("Compress::Zlib") ) {
- $prefer = 2;
- } else {
- $CPAN::Frontend->mydie(qq{
-CPAN.pm needs either the external programs tar, gzip and bzip2
-installed. Can't continue.
-});
- }
- my $tar_verb = "v";
- if (defined $CPAN::Config->{tar_verbosity}) {
- $tar_verb = $CPAN::Config->{tar_verbosity} eq "none" ? "" :
- $CPAN::Config->{tar_verbosity};
- }
- if ($prefer==1) { # 1 => external gzip+tar
- my($system);
- my $is_compressed = $self->gtest();
- my $tarcommand = CPAN::HandleConfig->safe_quote($CPAN::Config->{tar}) || "tar";
- if ($is_compressed) {
- my $command = CPAN::HandleConfig->safe_quote($self->{UNGZIPPRG});
- $system = qq{$command -dc }.
- qq{< "$file" | $tarcommand x${tar_verb}f -};
- } else {
- $system = qq{$tarcommand x${tar_verb}f "$file"};
- }
- if (system($system) != 0) {
- # people find the most curious tar binaries that cannot handle
- # pipes
- if ($is_compressed) {
- (my $ungzf = $file) =~ s/\.gz(?!\n)\Z//;
- $ungzf = File::Basename::basename($ungzf);
- my $ct = CPAN::Tarzip->new($file);
- if ($ct->gunzip($ungzf)) {
- $CPAN::Frontend->myprint(qq{Uncompressed $file successfully\n});
- } else {
- $CPAN::Frontend->mydie(qq{Couldn\'t uncompress $file\n});
- }
- $file = $ungzf;
- }
- $system = qq{$tarcommand x${tar_verb}f "$file"};
- $CPAN::Frontend->myprint(qq{Using Tar:$system:\n});
- if (system($system)==0) {
- $CPAN::Frontend->myprint(qq{Untarred $file successfully\n});
- } else {
- $CPAN::Frontend->mydie(qq{Couldn\'t untar $file\n});
- }
- return 1;
- } else {
- return 1;
- }
- } elsif ($prefer==2) { # 2 => modules
- unless ($CPAN::META->has_usable("Archive::Tar")) {
- $CPAN::Frontend->mydie("Archive::Tar not installed, please install it to continue");
- }
- my $tar = Archive::Tar->new($file,1);
- my $af; # archive file
- my @af;
- if ($BUGHUNTING) {
- # RCS 1.337 had this code, it turned out unacceptable slow but
- # it revealed a bug in Archive::Tar. Code is only here to hunt
- # the bug again. It should never be enabled in published code.
- # GDGraph3d-0.53 was an interesting case according to Larry
- # Virden.
- warn(">>>Bughunting code enabled<<< " x 20);
- for $af ($tar->list_files) {
- if ($af =~ m!^(/|\.\./)!) {
- $CPAN::Frontend->mydie("ALERT: Archive contains ".
- "illegal member [$af]");
- }
- $CPAN::Frontend->myprint("$af\n");
- $tar->extract($af); # slow but effective for finding the bug
- return if $CPAN::Signal;
- }
- } else {
- for $af ($tar->list_files) {
- if ($af =~ m!^(/|\.\./)!) {
- $CPAN::Frontend->mydie("ALERT: Archive contains ".
- "illegal member [$af]");
- }
- if ($tar_verb eq "v" || $tar_verb eq "vv") {
- $CPAN::Frontend->myprint("$af\n");
- }
- push @af, $af;
- return if $CPAN::Signal;
- }
- $tar->extract(@af) or
- $CPAN::Frontend->mydie("Could not untar with Archive::Tar.");
- }
-
- Mac::BuildTools::convert_files([$tar->list_files], 1)
- if ($^O eq 'MacOS');
-
- return 1;
- }
-}
-
-sub unzip {
- my($self) = @_;
- my $file = $self->{FILE};
- if ($CPAN::META->has_inst("Archive::Zip")) {
- # blueprint of the code from Archive::Zip::Tree::extractTree();
- my $zip = Archive::Zip->new();
- my $status;
- $status = $zip->read($file);
- $CPAN::Frontend->mydie("Read of file[$file] failed\n")
- if $status != Archive::Zip::AZ_OK();
- $CPAN::META->debug("Successfully read file[$file]") if $CPAN::DEBUG;
- my @members = $zip->members();
- for my $member ( @members ) {
- my $af = $member->fileName();
- if ($af =~ m!^(/|\.\./)!) {
- $CPAN::Frontend->mydie("ALERT: Archive contains ".
- "illegal member [$af]");
- }
- $status = $member->extractToFileNamed( $af );
- $CPAN::META->debug("af[$af]status[$status]") if $CPAN::DEBUG;
- $CPAN::Frontend->mydie("Extracting of file[$af] from zipfile[$file] failed\n") if
- $status != Archive::Zip::AZ_OK();
- return if $CPAN::Signal;
- }
- return 1;
- } else {
- my $unzip = $CPAN::Config->{unzip} or
- $CPAN::Frontend->mydie("Cannot unzip, no unzip program available");
- my @system = ($unzip, $file);
- return system(@system) == 0;
- }
-}
-
-1;
-
-__END__
-
-=head1 LICENSE
-
-This program is free software; you can redistribute it and/or
-modify it under the same terms as Perl itself.
-
-=cut
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/CPAN/Version.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/CPAN/Version.pm
deleted file mode 100644
index da876aac2d7..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/CPAN/Version.pm
+++ /dev/null
@@ -1,173 +0,0 @@
-package CPAN::Version;
-
-use strict;
-use vars qw($VERSION);
-$VERSION = "5.5";
-
-# CPAN::Version::vcmp courtesy Jost Krieger
-sub vcmp {
- my($self,$l,$r) = @_;
- local($^W) = 0;
- CPAN->debug("l[$l] r[$r]") if $CPAN::DEBUG;
-
- return 0 if $l eq $r; # short circuit for quicker success
-
- for ($l,$r) {
- s/_//g;
- }
- CPAN->debug("l[$l] r[$r]") if $CPAN::DEBUG;
- for ($l,$r) {
- next unless tr/.// > 1 || /^v/;
- s/^v?/v/;
- 1 while s/\.0+(\d)/.$1/; # remove leading zeroes per group
- }
- CPAN->debug("l[$l] r[$r]") if $CPAN::DEBUG;
- if ($l=~/^v/ <=> $r=~/^v/) {
- for ($l,$r) {
- next if /^v/;
- $_ = $self->float2vv($_);
- }
- }
- CPAN->debug("l[$l] r[$r]") if $CPAN::DEBUG;
- my $lvstring = "v0";
- my $rvstring = "v0";
- if ($] >= 5.006
- && $l =~ /^v/
- && $r =~ /^v/) {
- $lvstring = $self->vstring($l);
- $rvstring = $self->vstring($r);
- CPAN->debug(sprintf "lv[%vd] rv[%vd]", $lvstring, $rvstring) if $CPAN::DEBUG;
- }
-
- return (
- ($l ne "undef") <=> ($r ne "undef")
- ||
- $lvstring cmp $rvstring
- ||
- $l <=> $r
- ||
- $l cmp $r
- );
-}
-
-sub vgt {
- my($self,$l,$r) = @_;
- $self->vcmp($l,$r) > 0;
-}
-
-sub vlt {
- my($self,$l,$r) = @_;
- 0 + ($self->vcmp($l,$r) < 0);
-}
-
-sub vge {
- my($self,$l,$r) = @_;
- $self->vcmp($l,$r) >= 0;
-}
-
-sub vle {
- my($self,$l,$r) = @_;
- 0 + ($self->vcmp($l,$r) <= 0);
-}
-
-sub vstring {
- my($self,$n) = @_;
- $n =~ s/^v// or die "CPAN::Version::vstring() called with invalid arg [$n]";
- pack "U*", split /\./, $n;
-}
-
-# vv => visible vstring
-sub float2vv {
- my($self,$n) = @_;
- my($rev) = int($n);
- $rev ||= 0;
- my($mantissa) = $n =~ /\.(\d{1,12})/; # limit to 12 digits to limit
- # architecture influence
- $mantissa ||= 0;
- $mantissa .= "0" while length($mantissa)%3;
- my $ret = "v" . $rev;
- while ($mantissa) {
- $mantissa =~ s/(\d{1,3})// or
- die "Panic: length>0 but not a digit? mantissa[$mantissa]";
- $ret .= ".".int($1);
- }
- # warn "n[$n]ret[$ret]";
- $ret =~ s/(\.0)+/.0/; # v1.0.0 => v1.0
- $ret;
-}
-
-sub readable {
- my($self,$n) = @_;
- $n =~ /^([\w\-\+\.]+)/;
-
- return $1 if defined $1 && length($1)>0;
- # if the first user reaches version v43, he will be treated as "+".
- # We'll have to decide about a new rule here then, depending on what
- # will be the prevailing versioning behavior then.
-
- if ($] < 5.006) { # or whenever v-strings were introduced
- # we get them wrong anyway, whatever we do, because 5.005 will
- # have already interpreted 0.2.4 to be "0.24". So even if he
- # indexer sends us something like "v0.2.4" we compare wrongly.
-
- # And if they say v1.2, then the old perl takes it as "v12"
-
- if (defined $CPAN::Frontend) {
- $CPAN::Frontend->mywarn("Suspicious version string seen [$n]\n");
- } else {
- warn("Suspicious version string seen [$n]\n");
- }
- return $n;
- }
- my $better = sprintf "v%vd", $n;
- CPAN->debug("n[$n] better[$better]") if $CPAN::DEBUG;
- return $better;
-}
-
-1;
-
-__END__
-
-=head1 NAME
-
-CPAN::Version - utility functions to compare CPAN versions
-
-=head1 SYNOPSIS
-
- use CPAN::Version;
-
- CPAN::Version->vgt("1.1","1.1.1"); # 1 bc. 1.1 > 1.001001
-
- CPAN::Version->vlt("1.1","1.1"); # 0 bc. 1.1 not < 1.1
-
- CPAN::Version->vcmp("1.1","1.1.1"); # 1 bc. first is larger
-
- CPAN::Version->vcmp("1.1.1","1.1"); # -1 bc. first is smaller
-
- CPAN::Version->readable(v1.2.3); # "v1.2.3"
-
- CPAN::Version->vstring("v1.2.3"); # v1.2.3
-
- CPAN::Version->float2vv(1.002003); # "v1.2.3"
-
-=head1 DESCRIPTION
-
-This module mediates between some version that perl sees in a package
-and the version that is published by the CPAN indexer.
-
-It's only written as a helper module for both CPAN.pm and CPANPLUS.pm.
-
-As it stands it predates version.pm but has the same goal: make
-version strings visible and comparable.
-
-=head1 LICENSE
-
-This program is free software; you can redistribute it and/or
-modify it under the same terms as Perl itself.
-
-=cut
-
-# Local Variables:
-# mode: cperl
-# cperl-indent-level: 4
-# End:
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Config/Tiny.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Config/Tiny.pm
deleted file mode 100644
index 4cb8620e8b3..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Config/Tiny.pm
+++ /dev/null
@@ -1,267 +0,0 @@
-package Config::Tiny;
-
-# If you thought Config::Simple was small...
-
-use strict;
-BEGIN {
- require 5.004;
- $Config::Tiny::VERSION = '2.12';
- $Config::Tiny::errstr = '';
-}
-
-# Create an empty object
-sub new { bless {}, shift }
-
-# Create an object from a file
-sub read {
- my $class = ref $_[0] ? ref shift : shift;
-
- # Check the file
- my $file = shift or return $class->_error( 'You did not specify a file name' );
- return $class->_error( "File '$file' does not exist" ) unless -e $file;
- return $class->_error( "'$file' is a directory, not a file" ) unless -f _;
- return $class->_error( "Insufficient permissions to read '$file'" ) unless -r _;
-
- # Slurp in the file
- local $/ = undef;
- open CFG, $file or return $class->_error( "Failed to open file '$file': $!" );
- my $contents = <CFG>;
- close CFG;
-
- $class->read_string( $contents );
-}
-
-# Create an object from a string
-sub read_string {
- my $class = ref $_[0] ? ref shift : shift;
- my $self = bless {}, $class;
- return undef unless defined $_[0];
-
- # Parse the file
- my $ns = '_';
- my $counter = 0;
- foreach ( split /(?:\015{1,2}\012|\015|\012)/, shift ) {
- $counter++;
-
- # Skip comments and empty lines
- next if /^\s*(?:\#|\;|$)/;
-
- # Remove inline comments
- s/\s\;\s.+$//g;
-
- # Handle section headers
- if ( /^\s*\[\s*(.+?)\s*\]\s*$/ ) {
- # Create the sub-hash if it doesn't exist.
- # Without this sections without keys will not
- # appear at all in the completed struct.
- $self->{$ns = $1} ||= {};
- next;
- }
-
- # Handle properties
- if ( /^\s*([^=]+?)\s*=\s*(.*?)\s*$/ ) {
- $self->{$ns}->{$1} = $2;
- next;
- }
-
- return $self->_error( "Syntax error at line $counter: '$_'" );
- }
-
- $self;
-}
-
-# Save an object to a file
-sub write {
- my $self = shift;
- my $file = shift or return $self->_error(
- 'No file name provided'
- );
-
- # Write it to the file
- open( CFG, '>' . $file ) or return $self->_error(
- "Failed to open file '$file' for writing: $!"
- );
- print CFG $self->write_string;
- close CFG;
-}
-
-# Save an object to a string
-sub write_string {
- my $self = shift;
-
- my $contents = '';
- foreach my $section ( sort { (($b eq '_') <=> ($a eq '_')) || ($a cmp $b) } keys %$self ) {
- my $block = $self->{$section};
- $contents .= "\n" if length $contents;
- $contents .= "[$section]\n" unless $section eq '_';
- foreach my $property ( sort keys %$block ) {
- $contents .= "$property=$block->{$property}\n";
- }
- }
-
- $contents;
-}
-
-# Error handling
-sub errstr { $Config::Tiny::errstr }
-sub _error { $Config::Tiny::errstr = $_[1]; undef }
-
-1;
-
-__END__
-
-=pod
-
-=head1 NAME
-
-Config::Tiny - Read/Write .ini style files with as little code as possible
-
-=head1 SYNOPSIS
-
- # In your configuration file
- rootproperty=blah
-
- [section]
- one=twp
- three= four
- Foo =Bar
- empty=
-
- # In your program
- use Config::Tiny;
-
- # Create a config
- my $Config = Config::Tiny->new();
-
- # Open the config
- $Config = Config::Tiny->read( 'file.conf' );
-
- # Reading properties
- my $rootproperty = $Config->{_}->{rootproperty};
- my $one = $Config->{section}->{one};
- my $Foo = $Config->{section}->{Foo};
-
- # Changing data
- $Config->{newsection} = { this => 'that' }; # Add a section
- $Config->{section}->{Foo} = 'Not Bar!'; # Change a value
- delete $Config->{_}; # Delete a value or section
-
- # Save a config
- $Config->write( 'file.conf' );
-
-=head1 DESCRIPTION
-
-C<Config::Tiny> is a perl class to read and write .ini style configuration
-files with as little code as possible, reducing load time and memory
-overhead. Most of the time it is accepted that Perl applications use a lot
-of memory and modules. The C<::Tiny> family of modules is specifically
-intended to provide an ultralight alternative to the standard modules.
-
-This module is primarily for reading human written files, and anything we
-write shouldn't need to have documentation/comments. If you need something
-with more power move up to L<Config::Simple>, L<Config::General> or one of
-the many other C<Config::> modules. To rephrase, L<Config::Tiny> does B<not>
-preserve your comments, whitespace, or the order of your config file.
-
-=head1 CONFIGURATION FILE SYNTAX
-
-Files are the same format as for windows .ini files. For example:
-
- [section]
- var1=value1
- var2=value2
-
-If a property is outside of a section at the beginning of a file, it will
-be assigned to the C<"root section">, available at C<$Config-E<gt>{_}>.
-
-Lines starting with C<'#'> or C<';'> are considered comments and ignored,
-as are blank lines.
-
-When writing back to the config file, all comments, custom whitespace,
-and the ordering of your config file elements is discarded. If you need
-to keep the human elements of a config when writing back, upgrade to
-something better, this module is not for you.
-
-=head1 METHODS
-
-=head2 new
-
-The constructor C<new> creates and returns an empty C<Config::Tiny> object.
-
-=head2 read $filename
-
-The C<read> constructor reads a config file, and returns a new
-C<Config::Tiny> object containing the properties in the file.
-
-Returns the object on success, or C<undef> on error.
-
-When C<read> fails, C<Config::Tiny> sets an error message internally
-you can recover via C<<Config::Tiny->errstr>>. Although in B<some>
-cases a failed C<read> will also set the operating system error
-variable C<$!>, not all errors do and you should not rely on using
-the C<$!> variable.
-
-=head2 read_string $string;
-
-The C<read_string> method takes as argument the contents of a config file
-as a string and returns the C<Config::Tiny> object for it.
-
-=head2 write $filename
-
-The C<write> method generates the file content for the properties, and
-writes it to disk to the filename specified.
-
-Returns true on success or C<undef> on error.
-
-=head2 write_string
-
-Generates the file content for the object and returns it as a string.
-
-=head2 errstr
-
-When an error occurs, you can retrieve the error message either from the
-C<$Config::Tiny::errstr> variable, or using the C<errstr()> method.
-
-=head2 property_string
-
-This method is called to produce the string used to represent the property in a
-section. It is passed the section name and property name.
-
-=head2 set
-
-This is a convenience is called to set a value found in the parsed config string. It is
-passed the section name, property name, and value.
-
-=head1 SUPPORT
-
-Bugs should be reported via the CPAN bug tracker at
-
-L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Config-Tiny>
-
-For other issues, or commercial enhancement or support, contact the author.
-
-=head1 AUTHOR
-
-Adam Kennedy E<lt>adamk@cpan.orgE<gt>
-
-=head1 ACKNOWLEGEMENTS
-
-Thanks to Sherzod Ruzmetov E<lt>sherzodr@cpan.orgE<gt> for
-L<Config::Simple>, which inspired this module by being not quite
-"simple" enough for me :)
-
-=head1 SEE ALSO
-
-L<Config::Simple>, L<Config::General>, L<ali.as>
-
-=head1 COPYRIGHT
-
-Copyright 2002 - 2007 Adam Kennedy.
-
-This program is free software; you can redistribute
-it and/or modify it under the same terms as Perl itself.
-
-The full text of the license can be found in the
-LICENSE file included with this module.
-
-=cut
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Devel/Symdump.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Devel/Symdump.pm
deleted file mode 100644
index 01a8e783f8f..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Devel/Symdump.pm
+++ /dev/null
@@ -1,468 +0,0 @@
-package Devel::Symdump;
-
-use 5.003;
-use Carp ();
-use strict;
-use vars qw($Defaults $VERSION *ENTRY $MAX_RECURSION);
-
-$VERSION = '2.08';
-$MAX_RECURSION = 97;
-
-$Defaults = {
- 'RECURS' => 0,
- 'AUTOLOAD' => {
- 'packages' => 1,
- 'scalars' => 1,
- 'arrays' => 1,
- 'hashes' => 1,
- 'functions' => 1,
- 'ios' => 1,
- 'unknowns' => 1,
- },
- 'SEEN' => {},
- };
-
-sub rnew {
- my($class,@packages) = @_;
- no strict "refs";
- my $self = bless {%${"$class\::Defaults"}}, $class;
- $self->{RECURS}++;
- $self->_doit(@packages);
-}
-
-sub new {
- my($class,@packages) = @_;
- no strict "refs";
- my $self = bless {%${"$class\::Defaults"}}, $class;
- $self->_doit(@packages);
-}
-
-sub _doit {
- my($self,@packages) = @_;
- @packages = ("main") unless @packages;
- $self->{RESULT} = $self->_symdump(@packages);
- return $self;
-}
-
-sub _symdump {
- my($self,@packages) = @_ ;
- my($key,$val,$num,$pack,@todo,$tmp);
- my $result = {};
- foreach $pack (@packages){
- no strict;
- while (($key,$val) = each(%{*{"$pack\::"}})) {
- my $gotone = 0;
- local(*ENTRY) = $val;
- #### SCALAR ####
- if (defined $val && defined *ENTRY{SCALAR}) {
- $result->{$pack}{SCALARS}{$key}++;
- $gotone++;
- }
- #### ARRAY ####
- if (defined $val && defined *ENTRY{ARRAY}) {
- $result->{$pack}{ARRAYS}{$key}++;
- $gotone++;
- }
- #### HASH ####
- if (defined $val && defined *ENTRY{HASH} && $key !~ /::/) {
- $result->{$pack}{HASHES}{$key}++;
- $gotone++;
- }
- #### PACKAGE ####
- if (defined $val && defined *ENTRY{HASH} && $key =~ /::$/ &&
- $key ne "main::" && $key ne "<none>::") {
- my($p) = $pack ne "main" ? "$pack\::" : "";
- ($p .= $key) =~ s/::$//;
- $result->{$pack}{PACKAGES}{$p}++;
- $gotone++;
- if (++$self->{SEEN}{*$val} > $Devel::Symdump::MAX_RECURSION){
- next;
- }
- push @todo, $p;
- }
- #### FUNCTION ####
- if (defined $val && defined *ENTRY{CODE}) {
- $result->{$pack}{FUNCTIONS}{$key}++;
- $gotone++;
- }
-
- #### IO #### had to change after 5.003_10
- if ($] > 5.003_10){
- if (defined $val && defined *ENTRY{IO}){ # fileno and telldir...
- $result->{$pack}{IOS}{$key}++;
- $gotone++;
- }
- } else {
- #### FILEHANDLE ####
- if (defined fileno(ENTRY)){
- $result->{$pack}{IOS}{$key}++;
- $gotone++;
- } elsif (defined telldir(ENTRY)){
- #### DIRHANDLE ####
- $result->{$pack}{IOS}{$key}++;
- $gotone++;
- }
- }
-
- #### SOMETHING ELSE ####
- unless ($gotone) {
- $result->{$pack}{UNKNOWNS}{$key}++;
- }
- }
- }
-
- return (@todo && $self->{RECURS})
- ? { %$result, %{$self->_symdump(@todo)} }
- : $result;
-}
-
-sub _partdump {
- my($self,$part)=@_;
- my ($pack, @result);
- my $prepend = "";
- foreach $pack (keys %{$self->{RESULT}}){
- $prepend = "$pack\::" unless $part eq 'PACKAGES';
- push @result, map {"$prepend$_"} keys %{$self->{RESULT}{$pack}{$part} || {}};
- }
- return @result;
-}
-
-# this is needed so we don't try to AUTOLOAD the DESTROY method
-sub DESTROY {}
-
-sub as_string {
- my $self = shift;
- my($type,@m);
- for $type (sort keys %{$self->{'AUTOLOAD'}}) {
- push @m, $type;
- push @m, "\t" . join "\n\t", map {
- s/([\000-\037\177])/ '^' . pack('c', ord($1) ^ 64) /eg;
- $_;
- } sort $self->_partdump(uc $type);
- }
- return join "\n", @m;
-}
-
-sub as_HTML {
- my $self = shift;
- my($type,@m);
- push @m, "<TABLE>";
- for $type (sort keys %{$self->{'AUTOLOAD'}}) {
- push @m, "<TR><TD valign=top><B>$type</B></TD>";
- push @m, "<TD>" . join ", ", map {
- s/([\000-\037\177])/ '^' .
- pack('c', ord($1) ^ 64)
- /eg; $_;
- } sort $self->_partdump(uc $type);
- push @m, "</TD></TR>";
- }
- push @m, "</TABLE>";
- return join "\n", @m;
-}
-
-sub diff {
- my($self,$second) = @_;
- my($type,@m);
- for $type (sort keys %{$self->{'AUTOLOAD'}}) {
- my(%first,%second,%all,$symbol);
- foreach $symbol ($self->_partdump(uc $type)){
- $first{$symbol}++;
- $all{$symbol}++;
- }
- foreach $symbol ($second->_partdump(uc $type)){
- $second{$symbol}++;
- $all{$symbol}++;
- }
- my(@typediff);
- foreach $symbol (sort keys %all){
- next if $first{$symbol} && $second{$symbol};
- push @typediff, "- $symbol" unless $second{$symbol};
- push @typediff, "+ $symbol" unless $first{$symbol};
- }
- foreach (@typediff) {
- s/([\000-\037\177])/ '^' . pack('c', ord($1) ^ 64) /eg;
- }
- push @m, $type, @typediff if @typediff;
- }
- return join "\n", @m;
-}
-
-sub inh_tree {
- my($self) = @_;
- return $self->{INHTREE} if ref $self && defined $self->{INHTREE};
- my($inherited_by) = {};
- my($m)="";
- my(@isa) = grep /\bISA$/, Devel::Symdump->rnew->arrays;
- my $isa;
- foreach $isa (sort @isa) {
- $isa =~ s/::ISA$//;
- my($isaisa);
- no strict 'refs';
- foreach $isaisa (@{"$isa\::ISA"}){
- $inherited_by->{$isaisa}{$isa}++;
- }
- }
- my $item;
- foreach $item (sort keys %$inherited_by) {
- $m .= "$item\n";
- $m .= _inh_tree($item,$inherited_by);
- }
- $self->{INHTREE} = $m if ref $self;
- $m;
-}
-
-sub _inh_tree {
- my($package,$href,$depth) = @_;
- return unless defined $href;
- $depth ||= 0;
- $depth++;
- if ($depth > 100){
- warn "Deep recursion in ISA\n";
- return;
- }
- my($m) = "";
- # print "DEBUG: package[$package]depth[$depth]\n";
- my $i;
- foreach $i (sort keys %{$href->{$package}}) {
- $m .= qq{\t} x $depth;
- $m .= qq{$i\n};
- $m .= _inh_tree($i,$href,$depth);
- }
- $m;
-}
-
-sub isa_tree{
- my($self) = @_;
- return $self->{ISATREE} if ref $self && defined $self->{ISATREE};
- my(@isa) = grep /\bISA$/, Devel::Symdump->rnew->arrays;
- my($m) = "";
- my($isa);
- foreach $isa (sort @isa) {
- $isa =~ s/::ISA$//;
- $m .= qq{$isa\n};
- $m .= _isa_tree($isa)
- }
- $self->{ISATREE} = $m if ref $self;
- $m;
-}
-
-sub _isa_tree{
- my($package,$depth) = @_;
- $depth ||= 0;
- $depth++;
- if ($depth > 100){
- warn "Deep recursion in ISA\n";
- return;
- }
- my($m) = "";
- # print "DEBUG: package[$package]depth[$depth]\n";
- my $isaisa;
- no strict 'refs';
- foreach $isaisa (@{"$package\::ISA"}) {
- $m .= qq{\t} x $depth;
- $m .= qq{$isaisa\n};
- $m .= _isa_tree($isaisa,$depth);
- }
- $m;
-}
-
-AUTOLOAD {
- my($self,@packages) = @_;
- unless (ref $self) {
- $self = $self->new(@packages);
- }
- no strict "vars";
- (my $auto = $AUTOLOAD) =~ s/.*:://;
-
- $auto =~ s/(file|dir)handles/ios/;
- my $compat = $1;
-
- unless ($self->{'AUTOLOAD'}{$auto}) {
- Carp::croak("invalid Devel::Symdump method: $auto()");
- }
-
- my @syms = $self->_partdump(uc $auto);
- if (defined $compat) {
- no strict 'refs';
- local $^W; # bleadperl@26631 introduced an io warning here
- if ($compat eq "file") {
- @syms = grep { defined(fileno($_)) } @syms;
- } else {
- @syms = grep { defined(telldir($_)) } @syms;
- }
- }
- return @syms; # make sure now it gets context right
-}
-
-1;
-
-__END__
-
-=head1 NAME
-
-Devel::Symdump - dump symbol names or the symbol table
-
-=head1 SYNOPSIS
-
- # Constructor
- require Devel::Symdump;
- @packs = qw(some_package another_package);
- $obj = Devel::Symdump->new(@packs); # no recursion
- $obj = Devel::Symdump->rnew(@packs); # with recursion
-
- # Methods
- @array = $obj->packages;
- @array = $obj->scalars;
- @array = $obj->arrays;
- @array = $obj->hashes;
- @array = $obj->functions;
- @array = $obj->filehandles; # deprecated, use ios instead
- @array = $obj->dirhandles; # deprecated, use ios instead
- @array = $obj->ios;
- @array = $obj->unknowns; # only perl version < 5.003 had some
-
- $string = $obj->as_string;
- $string = $obj->as_HTML;
- $string = $obj1->diff($obj2);
-
- $string = Devel::Symdump->isa_tree; # or $obj->isa_tree
- $string = Devel::Symdump->inh_tree; # or $obj->inh_tree
-
- # Methods with autogenerated objects
- # all of those call new(@packs) internally
- @array = Devel::Symdump->packages(@packs);
- @array = Devel::Symdump->scalars(@packs);
- @array = Devel::Symdump->arrays(@packs);
- @array = Devel::Symdump->hashes(@packs);
- @array = Devel::Symdump->functions(@packs);
- @array = Devel::Symdump->ios(@packs);
- @array = Devel::Symdump->unknowns(@packs);
-
-=head1 DESCRIPTION
-
-This little package serves to access the symbol table of perl.
-
-=over 4
-
-=item C<Devel::Symdump-E<gt>rnew(@packages)>
-
-returns a symbol table object for all subtrees below @packages.
-Nested Modules are analyzed recursively. If no package is given as
-argument, it defaults to C<main>. That means to get the whole symbol
-table, just do a C<rnew> without arguments.
-
-The global variable $Devel::Symdump::MAX_RECURSION limits the
-recursion to prevent contention. The default value is set to 97, just
-low enough to survive the test suite without a warning about deep
-recursion.
-
-=item C<Devel::Symdump-E<gt>new(@packages)>
-
-does not go into recursion and only analyzes the packages that are
-given as arguments.
-
-=item packages, scalars, arrays, hashes, functions, ios
-
-The methods packages(), scalars(), arrays(), hashes(), functions(),
-ios(), and (for older perls) unknowns() each return an array of fully
-qualified symbols of the specified type in all packages that are held
-within a Devel::Symdump object, but without the leading C<$>, C<@> or
-C<%>. In a scalar context, they will return the number of such
-symbols. Unknown symbols are usually either formats or variables that
-haven't yet got a defined value.
-
-=item as_string
-
-=item as_HTML
-
-As_string() and as_HTML() return a simple string/HTML representations
-of the object.
-
-=item diff
-
-Diff() prints the difference between two Devel::Symdump objects in
-human readable form. The format is similar to the one used by the
-as_string method.
-
-=item isa_tree
-
-=item inh_tree
-
-Isa_tree() and inh_tree() both return a simple string representation
-of the current inheritance tree. The difference between the two
-methods is the direction from which the tree is viewed: top-down or
-bottom-up. As I'm sure, many users will have different expectation
-about what is top and what is bottom, I'll provide an example what
-happens when the Socket module is loaded:
-
-=item % print Devel::Symdump-E<gt>inh_tree
-
- AutoLoader
- DynaLoader
- Socket
- DynaLoader
- Socket
- Exporter
- Carp
- Config
- Socket
-
-The inh_tree method shows on the left hand side a package name and
-indented to the right the packages that use the former.
-
-=item % print Devel::Symdump-E<gt>isa_tree
-
- Carp
- Exporter
- Config
- Exporter
- DynaLoader
- AutoLoader
- Socket
- Exporter
- DynaLoader
- AutoLoader
-
-The isa_tree method displays from left to right ISA relationships, so
-Socket IS A DynaLoader and DynaLoader IS A AutoLoader. (Actually, they
-were at the time this manpage was written)
-
-=back
-
-You may call both methods, isa_tree() and inh_tree(), with an
-object. If you do that, the object will store the output and retrieve
-it when you call the same method again later. The typical usage would
-be to use them as class methods directly though.
-
-=head1 SUBCLASSING
-
-The design of this package is intentionally primitive and allows it to
-be subclassed easily. An example of a (maybe) useful subclass is
-Devel::Symdump::Export, a package which exports all methods of the
-Devel::Symdump package and turns them into functions.
-
-=head1 AUTHORS
-
-Andreas Koenig F<< <andk@cpan.org> >> and Tom Christiansen
-F<< <tchrist@perl.com> >>. Based on the old F<dumpvar.pl> by Larry
-Wall.
-
-=head1 COPYRIGHT, LICENSE
-
-This module is
-
-Copyright (c) 1995, 1997, 2000, 2002, 2005, 2006 Andreas Koenig C<< <andk@cpan.org> >>.
-
-All rights reserved.
-
-This library is free software;
-you may use, redistribute and/or modify it under the same
-terms as Perl itself.
-
-=cut
-
-
-# Local Variables:
-# mode: cperl
-# cperl-indent-level: 4
-# End:
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Devel/Symdump/Export.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Devel/Symdump/Export.pm
deleted file mode 100644
index 2401e5f542b..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Devel/Symdump/Export.pm
+++ /dev/null
@@ -1,39 +0,0 @@
-package Devel::Symdump::Export;
-require Devel::Symdump;
-require Exporter;
-use Carp;
-use strict;
-use vars qw(@ISA @EXPORT_OK $AUTOLOAD);
-@ISA=('Exporter');
-
-@EXPORT_OK=(
- 'packages' ,
- 'scalars' ,
- 'arrays' ,
- 'hashes' ,
- 'functions' ,
- 'filehandles' ,
- 'dirhandles' ,
- 'ios' ,
- 'unknowns' ,
-);
-my %OK;
-@OK{@EXPORT_OK}=(1) x @EXPORT_OK;
-
-push @EXPORT_OK, "symdump";
-
-# undocumented feature symdump() -- does it save enough typing?
-sub symdump {
- my @packages = @_;
- Devel::Symdump->new(@packages)->as_string;
-}
-
-AUTOLOAD {
- my @packages = @_;
- (my $auto = $AUTOLOAD) =~ s/.*:://;
- confess("Unknown function call $auto") unless $OK{$auto};
- my @ret = Devel::Symdump->new->$auto(@packages);
- return @ret;
-}
-
-1;
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/File/._Temp.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/File/._Temp.pm
deleted file mode 100644
index 25f8275c418..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/File/._Temp.pm
+++ /dev/null
Binary files differ
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/File/Copy/Recursive.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/File/Copy/Recursive.pm
deleted file mode 100644
index a191adb0a6c..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/File/Copy/Recursive.pm
+++ /dev/null
@@ -1,641 +0,0 @@
-package File::Copy::Recursive;
-
-use strict;
-BEGIN {
- # Keep older versions of Perl from trying to use lexical warnings
- $INC{'warnings.pm'} = "fake warnings entry for < 5.6 perl ($])" if $] < 5.006;
-}
-use warnings;
-
-use Carp;
-use File::Copy;
-use File::Spec; #not really needed because File::Copy already gets it, but for good measure :)
-
-use vars qw(
- @ISA @EXPORT_OK $VERSION $MaxDepth $KeepMode $CPRFComp $CopyLink
- $PFSCheck $RemvBase $NoFtlPth $ForcePth $CopyLoop $RMTrgFil $RMTrgDir
- $CondCopy $BdTrgWrn $SkipFlop
-);
-
-require Exporter;
-@ISA = qw(Exporter);
-@EXPORT_OK = qw(fcopy rcopy dircopy fmove rmove dirmove pathmk pathrm pathempty pathrmdir);
-$VERSION = '0.36';
-
-$MaxDepth = 0;
-$KeepMode = 1;
-$CPRFComp = 0;
-$CopyLink = eval { local $SIG{'__DIE__'};symlink '',''; 1 } || 0;
-$PFSCheck = 1;
-$RemvBase = 0;
-$NoFtlPth = 0;
-$ForcePth = 0;
-$CopyLoop = 0;
-$RMTrgFil = 0;
-$RMTrgDir = 0;
-$CondCopy = {};
-$BdTrgWrn = 0;
-$SkipFlop = 0;
-
-my $samecheck = sub {
- return 1 if $^O eq 'MSWin32'; # need better way to check for this on winders...
- return if @_ != 2 || !defined $_[0] || !defined $_[1];
- return if $_[0] eq $_[1];
-
- my $one = '';
- if($PFSCheck) {
- $one = join( '-', ( stat $_[0] )[0,1] ) || '';
- my $two = join( '-', ( stat $_[1] )[0,1] ) || '';
- if ( $one eq $two && $one ) {
- carp "$_[0] and $_[1] are identical";
- return;
- }
- }
-
- if(-d $_[0] && !$CopyLoop) {
- $one = join( '-', ( stat $_[0] )[0,1] ) if !$one;
- my $abs = File::Spec->rel2abs($_[1]);
- my @pth = File::Spec->splitdir( $abs );
- while(@pth) {
- my $cur = File::Spec->catdir(@pth);
- last if !$cur; # probably not necessary, but nice to have just in case :)
- my $two = join( '-', ( stat $cur )[0,1] ) || '';
- if ( $one eq $two && $one ) {
- # $! = 62; # Too many levels of symbolic links
- carp "Caught Deep Recursion Condition: $_[0] contains $_[1]";
- return;
- }
-
- pop @pth;
- }
- }
-
- return 1;
-};
-
-my $move = sub {
- my $fl = shift;
- my @x;
- if($fl) {
- @x = fcopy(@_) or return;
- } else {
- @x = dircopy(@_) or return;
- }
- if(@x) {
- if($fl) {
- unlink $_[0] or return;
- } else {
- pathrmdir($_[0]) or return;
- }
- if($RemvBase) {
- my ($volm, $path) = File::Spec->splitpath($_[0]);
- pathrm(File::Spec->catpath($volm,$path,''), $ForcePth, $NoFtlPth) or return;
- }
- }
- return wantarray ? @x : $x[0];
-};
-
-my $ok_todo_asper_condcopy = sub {
- my $org = shift;
- my $copy = 1;
- if(exists $CondCopy->{$org}) {
- if($CondCopy->{$org}{'md5'}) {
-
- }
- if($copy) {
-
- }
- }
- return $copy;
-};
-
-sub fcopy {
- $samecheck->(@_) or return;
- if($RMTrgFil && (-d $_[1] || -e $_[1]) ) {
- my $trg = $_[1];
- if( -d $trg ) {
- my @trgx = File::Spec->splitpath( $_[0] );
- $trg = File::Spec->catfile( $_[1], $trgx[ $#trgx ] );
- }
- $samecheck->($_[0], $trg) or return;
- if(-e $trg) {
- if($RMTrgFil == 1) {
- unlink $trg or carp "\$RMTrgFil failed: $!";
- } else {
- unlink $trg or return;
- }
- }
- }
- my ($volm, $path) = File::Spec->splitpath($_[1]);
- if($path && !-d $path) {
- pathmk(File::Spec->catpath($volm,$path,''), $NoFtlPth);
- }
- if( -l $_[0] && $CopyLink ) {
- carp "Copying a symlink ($_[0]) whose target does not exist"
- if !-e readlink($_[0]) && $BdTrgWrn;
- symlink readlink(shift()), shift() or return;
- } else {
- copy(@_) or return;
-
- my @base_file = File::Spec->splitpath($_[0]);
- my $mode_trg = -d $_[1] ? File::Spec->catfile($_[1], $base_file[ $#base_file ]) : $_[1];
-
- chmod scalar((stat($_[0]))[2]), $mode_trg if $KeepMode;
- }
- return wantarray ? (1,0,0) : 1; # use 0's incase they do math on them and in case rcopy() is called in list context = no uninit val warnings
-}
-
-sub rcopy {
- -d $_[0] || substr( $_[0], ( 1 * -1), 1) eq '*' ? dircopy(@_)
- : fcopy(@_);
-}
-
-sub dircopy {
- if($RMTrgDir && -d $_[1]) {
- if($RMTrgDir == 1) {
- pathrmdir($_[1]) or carp "\$RMTrgDir failed: $!";
- } else {
- pathrmdir($_[1]) or return;
- }
- }
- my $globstar = 0;
- my $_zero = $_[0];
- my $_one = $_[1];
- if ( substr( $_zero, ( 1 * -1 ), 1 ) eq '*') {
- $globstar = 1;
- $_zero = substr( $_zero, 0, ( length( $_zero ) - 1 ) );
- }
-
- $samecheck->( $_zero, $_[1] ) or return;
- if ( !-d $_zero || ( -e $_[1] && !-d $_[1] ) ) {
- $! = 20;
- return;
- }
-
- if(!-d $_[1]) {
- pathmk($_[1], $NoFtlPth) or return;
- } else {
- if($CPRFComp && !$globstar) {
- my @parts = File::Spec->splitdir($_zero);
- while($parts[ $#parts ] eq '') { pop @parts; }
- $_one = File::Spec->catdir($_[1], $parts[$#parts]);
- }
- }
- my $baseend = $_one;
- my $level = 0;
- my $filen = 0;
- my $dirn = 0;
-
- my $recurs; #must be my()ed before sub {} since it calls itself
- $recurs = sub {
- my ($str,$end,$buf) = @_;
- $filen++ if $end eq $baseend;
- $dirn++ if $end eq $baseend;
- mkdir $end or return if !-d $end;
- chmod scalar((stat($str))[2]), $end if $KeepMode;
- if($MaxDepth && $MaxDepth =~ m/^\d+$/ && $level >= $MaxDepth) {
- return ($filen,$dirn,$level) if wantarray;
- return $filen;
- }
- $level++;
-
-
- my @files;
- if ( $] < 5.006 ) {
- opendir(STR_DH, $str) or return;
- @files = grep( $_ ne '.' && $_ ne '..', readdir(STR_DH));
- closedir STR_DH;
- }
- else {
- opendir(my $str_dh, $str) or return;
- @files = grep( $_ ne '.' && $_ ne '..', readdir($str_dh));
- closedir $str_dh;
- }
-
- for my $file (@files) {
- my ($file_ut) = $file =~ m{ (.*) }xms;
- my $org = File::Spec->catfile($str, $file_ut);
- my $new = File::Spec->catfile($end, $file_ut);
- if( -l $org && $CopyLink ) {
- carp "Copying a symlink ($org) whose target does not exist"
- if !-e readlink($org) && $BdTrgWrn;
- symlink readlink($org), $new or return;
- }
- elsif(-d $org) {
- $recurs->($org,$new,$buf) if defined $buf;
- $recurs->($org,$new) if !defined $buf;
- $filen++;
- $dirn++;
- }
- else {
- if($ok_todo_asper_condcopy->($org)) {
- if($SkipFlop) {
- fcopy($org,$new,$buf) or next if defined $buf;
- fcopy($org,$new) or next if !defined $buf;
- }
- else {
- fcopy($org,$new,$buf) or return if defined $buf;
- fcopy($org,$new) or return if !defined $buf;
- }
- chmod scalar((stat($org))[2]), $new if $KeepMode;
- $filen++;
- }
- }
- }
- 1;
- };
-
- $recurs->($_zero, $_one, $_[2]) or return;
- return wantarray ? ($filen,$dirn,$level) : $filen;
-}
-
-sub fmove { $move->(1, @_) }
-
-sub rmove {
- my $_zero = shift;
- $_zero = substr( $_zero, 0, ( length( $_zero ) - 1 ) )
- if substr( $_[0], ( 1 * -1), 1) eq '*';
-
- -d $_zero ? dirmove($_zero, @_) : fmove($_zero, @_);
-}
-
-sub dirmove { $move->(0, @_) }
-
-sub pathmk {
- my @parts = File::Spec->splitdir( shift() );
- my $nofatal = shift;
- my $pth = $parts[0];
- my $zer = 0;
- if(!$pth) {
- $pth = File::Spec->catdir($parts[0],$parts[1]);
- $zer = 1;
- }
- for($zer..$#parts) {
- mkdir $pth or return if !-d $pth && !$nofatal;
- mkdir $pth if !-d $pth && $nofatal;
- $pth = File::Spec->catdir($pth, $parts[$_ + 1]) unless $_ == $#parts;
- }
- 1;
-}
-
-sub pathempty {
- my $pth = shift;
-
- return 2 if !-d $pth;
-
- my @names;
- my $pth_dh;
- if ( $] < 5.006 ) {
- opendir(PTH_DH, $pth) or return;
- @names = grep !/^\.+$/, readdir(PTH_DH);
- }
- else {
- opendir($pth_dh, $pth) or return;
- @names = grep !/^\.+$/, readdir($pth_dh);
- }
-
- for my $name (@names) {
- my ($name_ut) = $name =~ m{ (.*) }xms;
- my $flpth = File::Spec->catdir($pth, $name_ut);
-
- if( -l $flpth ) {
- unlink $flpth or return;
- }
- elsif(-d $flpth) {
- pathrmdir($flpth) or return;
- }
- else {
- unlink $flpth or return;
- }
- }
-
- if ( $] < 5.006 ) {
- closedir PTH_DH;
- }
- else {
- closedir $pth_dh;
- }
-
- 1;
-}
-
-sub pathrm {
- my $path = shift;
- return 2 if !-d $path;
- my @pth = File::Spec->splitdir( $path );
- my $force = shift;
-
- while(@pth) {
- my $cur = File::Spec->catdir(@pth);
- last if !$cur; # necessary ???
- if(!shift()) {
- pathempty($cur) or return if $force;
- rmdir $cur or return;
- }
- else {
- pathempty($cur) if $force;
- rmdir $cur;
- }
- pop @pth;
- }
- 1;
-}
-
-sub pathrmdir {
- my $dir = shift;
- if( -e $dir ) {
- return if !-d $dir;
- }
- else {
- return 2;
- }
-
- pathempty($dir) or return;
-
- rmdir $dir or return;
-}
-
-1;
-
-__END__
-
-=head1 NAME
-
-File::Copy::Recursive - Perl extension for recursively copying files and directories
-
-=head1 SYNOPSIS
-
- use File::Copy::Recursive qw(fcopy rcopy dircopy fmove rmove dirmove);
-
- fcopy($orig,$new[,$buf]) or die $!;
- rcopy($orig,$new[,$buf]) or die $!;
- dircopy($orig,$new[,$buf]) or die $!;
-
- fmove($orig,$new[,$buf]) or die $!;
- rmove($orig,$new[,$buf]) or die $!;
- dirmove($orig,$new[,$buf]) or die $!;
-
-=head1 DESCRIPTION
-
-This module copies and moves directories recursively (or single files, well... singley) to an optional depth and attempts to preserve each file or directory's mode.
-
-=head1 EXPORT
-
-None by default. But you can export all the functions as in the example above and the path* functions if you wish.
-
-=head2 fcopy()
-
-This function uses File::Copy's copy() function to copy a file but not a directory. Any directories are recursively created if need be.
-One difference to File::Copy::copy() is that fcopy attempts to preserve the mode (see Preserving Mode below)
-The optional $buf in the synopsis if the same as File::Copy::copy()'s 3rd argument
-returns the same as File::Copy::copy() in scalar context and 1,0,0 in list context to accomidate rcopy()'s list context on regular files. (See below for more info)
-
-=head2 dircopy()
-
-This function recursively traverses the $orig directory's structure and recursively copies it to the $new directory.
-$new is created if necessary (multiple non existant directories is ok (IE foo/bar/baz). The script logically and portably creates all of them if necessary).
-It attempts to preserve the mode (see Preserving Mode below) and
-by default it copies all the way down into the directory, (see Managing Depth) below.
-If a directory is not specified it croaks just like fcopy croaks if its not a file that is specified.
-
-returns true or false, for true in scalar context it returns the number of files and directories copied,
-In list context it returns the number of files and directories, number of directories only, depth level traversed.
-
- my $num_of_files_and_dirs = dircopy($orig,$new);
- my($num_of_files_and_dirs,$num_of_dirs,$depth_traversed) = dircopy($orig,$new);
-
-Normally it stops and return's if a copy fails, to continue on regardless set $File::Copy::Recursive::SkipFlop to true.
-
- local $File::Copy::Recursive::SkipFlop = 1;
-
-That way it will copy everythgingit can ina directory and won't stop because of permissions, etc...
-
-=head2 rcopy()
-
-This function will allow you to specify a file *or* directory. It calls fcopy() if its a file and dircopy() if its a directory.
-If you call rcopy() (or fcopy() for that matter) on a file in list context, the values will be 1,0,0 since no directories and no depth are used.
-This is important becasue if its a directory in list context and there is only the initial directory the return value is 1,1,1.
-
-=head2 fmove()
-
-Copies the file then removes the original. You can manage the path the original file is in according to $RemvBase.
-
-=head2 dirmove()
-
-Uses dircopy() to copy the directory then removes the original. You can manage the path the original directory is in according to $RemvBase.
-
-=head2 rmove()
-
-Like rcopy() but calls fmove() or dirmove() instead.
-
-=head3 $RemvBase
-
-Default is false. When set to true the *move() functions will not only attempt to remove the original file or directory but will remove the given path it is in.
-
-So if you:
-
- rmove('foo/bar/baz', '/etc/');
- # "baz" is removed from foo/bar after it is successfully copied to /etc/
-
- local $File::Copy::Recursive::Remvbase = 1;
- rmove('foo/bar/baz','/etc/');
- # if baz is successfully copied to /etc/ :
- # first "baz" is removed from foo/bar
- # then "foo/bar is removed via pathrm()
-
-=head4 $ForcePth
-
-Default is false. When set to true it calls pathempty() before any directories are removed to empty the directory so it can be rmdir()'ed when $RemvBase is in effect.
-
-=head2 Creating and Removing Paths
-
-=head3 $NoFtlPth
-
-Default is false. If set to true rmdir(), mkdir(), and pathempty() calls in pathrm() and pathmk() do not return() on failure.
-
-If its set to true they just silently go about their business regardless. This isn't a good idea but its there if you want it.
-
-=head3 Path functions
-
-These functions exist soley because they were necessary for the move and copy functions to have the features they do and not because they are of themselves the purpose of this module. That being said, here is how they work so you can understand how the copy and move funtions work and use them by themselves if you wish.
-
-=head4 pathrm()
-
-Removes a given path recursively. It removes the *entire* path so be carefull!!!
-
-Returns 2 if the given path is not a directory.
-
- File::Copy::Recursive::pathrm('foo/bar/baz') or die $!;
- # foo no longer exists
-
-Same as:
-
- rmdir 'foo/bar/baz' or die $!;
- rmdir 'foo/bar' or die $!;
- rmdir 'foo' or die $!;
-
-An optional second argument makes it call pathempty() before any rmdir()'s when set to true.
-
- File::Copy::Recursive::pathrm('foo/bar/baz', 1) or die $!;
- # foo no longer exists
-
-Same as:
-
- File::Copy::Recursive::pathempty('foo/bar/baz') or die $!;
- rmdir 'foo/bar/baz' or die $!;
- File::Copy::Recursive::pathempty('foo/bar/') or die $!;
- rmdir 'foo/bar' or die $!;
- File::Copy::Recursive::pathempty('foo/') or die $!;
- rmdir 'foo' or die $!;
-
-An optional third argument acts like $File::Copy::Recursive::NoFtlPth, again probably not a good idea.
-
-=head4 pathempty()
-
-Recursively removes the given directory's contents so it is empty. returns 2 if argument is not a directory, 1 on successfully emptying the directory.
-
- File::Copy::Recursive::pathempty($pth) or die $!;
- # $pth is now an empty directory
-
-=head4 pathmk()
-
-Creates a given path recursively. Creates foo/bar/baz even if foo does not exist.
-
- File::Copy::Recursive::pathmk('foo/bar/baz') or die $!;
-
-An optional second argument if true acts just like $File::Copy::Recursive::NoFtlPth, which means you'd never get your die() if something went wrong. Again, probably a *bad* idea.
-
-=head4 pathrmdir()
-
-Same as rmdir() but it calls pathempty() first to recursively empty it first since rmdir can not remove a directory with contents.
-Just removes the top directory the path given insetad of the entire path like pathrm(). Return 2 if the given argument is not a directory.
-
-=head2 Preserving Mode
-
-By default a quiet attempt is made to change the new file or directory to the mode of the old one.
-To turn this behavior off set
- $File::Copy::Recursive::KeepMode
-to false;
-
-=head2 Managing Depth
-
-You can set the maximum depth a directory structure is recursed by setting:
- $File::Copy::Recursive::MaxDepth
-to a whole number greater than 0.
-
-=head2 SymLinks
-
-If your system supports symlinks then symlinks will be copied as symlinks instead of as the target file.
-Perl's symlink() is used instead of File::Copy's copy()
-You can customize this behavior by setting $File::Copy::Recursive::CopyLink to a true or false value.
-It is already set to true or false dending on your system's support of symlinks so you can check it with an if statement to see how it will behave:
-
- if($File::Copy::Recursive::CopyLink) {
- print "Symlinks will be preserved\n";
- } else {
- print "Symlinks will not be preserved because your system does not support it\n";
- }
-
-If symlinks are being copied you can set $File::Copy::Recursive::BdTrgWrn to true to make it carp when it copies a link whose target does not exist. Its false by default.
-
- local $File::Copy::Recursive::BdTrgWrn = 1;
-
-=head2 Removing existing target file or directory before copying.
-
-This can be done by setting $File::Copy::Recursive::RMTrgFil or $File::Copy::Recursive::RMTrgDir for file or directory behavior respectively.
-
-0 = off (This is the default)
-
-1 = carp() $! if removal fails
-
-2 = return if removal fails
-
- local $File::Copy::Recursive::RMTrgFil = 1;
- fcopy($orig, $target) or die $!;
- # if it fails it does warn() and keeps going
-
- local $File::Copy::Recursive::RMTrgDir = 2;
- dircopy($orig, $target) or die $!;
- # if it fails it does your "or die"
-
-This should be unnecessary most of the time but its there if you need it :)
-
-=head2 Turning off stat() check
-
-By default the files or directories are checked to see if they are the same (IE linked, or two paths (absolute/relative or different relative paths) to the same file) by comparing the file's stat() info.
-It's a very efficient check that croaks if they are and shouldn't be turned off but if you must for some weird reason just set $File::Copy::Recursive::PFSCheck to a false value. ("PFS" stands for "Physical File System")
-
-=head2 Emulating cp -rf dir1/ dir2/
-
-By default dircopy($dir1,$dir2) will put $dir1's contents right into $dir2 whether $dir2 exists or not.
-
-You can make dircopy() emulate cp -rf by setting $File::Copy::Recursive::CPRFComp to true.
-
-NOTE: This only emulates -f in the sense that it does not prompt. It does not remove the target file or directory if it exists.
-If you need to do that then use the variables $RMTrgFil and $RMTrgDir described in "Removing existing target file or directory before copying" above.
-
-That means that if $dir2 exists it puts the contents into $dir2/$dir1 instead of $dir2 just like cp -rf.
-If $dir2 does not exist then the contents go into $dir2 like normal (also like cp -rf)
-
-So assuming 'foo/file':
-
- dircopy('foo', 'bar') or die $!;
- # if bar does not exist the result is bar/file
- # if bar does exist the result is bar/file
-
- $File::Copy::Recursive::CPRFComp = 1;
- dircopy('foo', 'bar') or die $!;
- # if bar does not exist the result is bar/file
- # if bar does exist the result is bar/foo/file
-
-You can also specify a star for cp -rf glob type behavior:
-
- dircopy('foo/*', 'bar') or die $!;
- # if bar does not exist the result is bar/file
- # if bar does exist the result is bar/file
-
- $File::Copy::Recursive::CPRFComp = 1;
- dircopy('foo/*', 'bar') or die $!;
- # if bar does not exist the result is bar/file
- # if bar does exist the result is bar/file
-
-NOTE: The '*' is only like cp -rf foo/* and *DOES NOT EXPAND PARTIAL DIRECTORY NAMES LIKE YOUR SHELL DOES* (IE not like cp -rf fo* to copy foo/*)
-
-=head2 Allowing Copy Loops
-
-If you want to allow:
-
- cp -rf . foo/
-
-type behavior set $File::Copy::Recursive::CopyLoop to true.
-
-This is false by default so that a check is done to see if the source directory will contain the target directory and croaks to avoid this problem.
-
-If you ever find a situation where $CopyLoop = 1 is desirable let me know (IE its a bad bad idea but is there if you want it)
-
-(Note: On Windows this was necessary since it uses stat() to detemine samedness and stat() is essencially useless for this on Windows.
-The test is now simply skipped on Windows but I'd rather have an actual reliable check if anyone in Microsoft land would care to share)
-
-=head1 SEE ALSO
-
-L<File::Copy> L<File::Spec>
-
-=head1 TO DO
-
-Add OO interface so you can have different behavior with different objects instead of relying on global variables.
-This will give better control in environments where behavior based on global variables is not very desireable.
-
-I'll add this after the latest verision has been out for a while with no new features or issues found :)
-
-=head1 AUTHOR
-
-Daniel Muey, L<http://drmuey.com/cpan_contact.pl>
-
-=head1 COPYRIGHT AND LICENSE
-
-Copyright 2004 by Daniel Muey
-
-This library is free software; you can redistribute it and/or modify
-it under the same terms as Perl itself.
-
-=cut
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/File/HomeDir.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/File/HomeDir.pm
deleted file mode 100644
index 3f205d9fd0d..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/File/HomeDir.pm
+++ /dev/null
@@ -1,619 +0,0 @@
-package File::HomeDir;
-
-# See POD at end for documentation
-
-use 5.005;
-use strict;
-use Carp ();
-use File::Spec ();
-
-# Globals
-use vars qw{$VERSION @ISA @EXPORT @EXPORT_OK $IMPLEMENTED_BY};
-BEGIN {
- $VERSION = '0.80';
-
- # Inherit manually
- require Exporter;
- @ISA = qw{ Exporter };
- @EXPORT = qw{ home };
- @EXPORT_OK = qw{
- home
- my_home
- my_desktop
- my_documents
- my_music
- my_pictures
- my_videos
- my_data
- users_home
- users_desktop
- users_documents
- users_music
- users_pictures
- users_videos
- users_data
- };
-
- # %~ doesn't need (and won't take) exporting, as it's a magic
- # symbol name that's always looked for in package 'main'.
-}
-
-# Inlined Params::Util functions
-sub _CLASS ($) {
- (defined $_[0] and ! ref $_[0] and $_[0] =~ m/^[^\W\d]\w*(?:::\w+)*$/s) ? $_[0] : undef;
-}
-sub _DRIVER ($$) {
- (defined _CLASS($_[0]) and eval "require $_[0];" and ! $@ and $_[0]->isa($_[1]) and $_[0] ne $_[1]) ? $_[0] : undef;
-}
-
-# Platform detection
-if ( $IMPLEMENTED_BY ) {
- # Allow for custom HomeDir classes
- # Leave it as the existing value
-} elsif ( $^O eq 'MSWin32' ) {
- # All versions of Windows
- $IMPLEMENTED_BY = 'File::HomeDir::Windows';
-} elsif ( $^O eq 'darwin' ) {
- # Modern Max OS X
- $IMPLEMENTED_BY = 'File::HomeDir::Darwin';
-} elsif ( $^O eq 'MacOS' ) {
- # Legacy Mac OS
- $IMPLEMENTED_BY = 'File::HomeDir::MacOS9';
-} else {
- # Default to Unix semantics
- $IMPLEMENTED_BY = 'File::HomeDir::Unix';
-}
-unless ( _DRIVER($IMPLEMENTED_BY, 'File::HomeDir::Driver') ) {
- Carp::croak("Missing or invalid File::HomeDir driver $IMPLEMENTED_BY");
-}
-
-
-
-
-
-#####################################################################
-# Current User Methods
-
-sub my_home {
- $IMPLEMENTED_BY->my_home;
-}
-
-sub my_desktop {
- $IMPLEMENTED_BY->can('my_desktop')
- ? $IMPLEMENTED_BY->my_desktop
- : Carp::croak("The my_desktop method is not implemented on this platform");
-}
-
-sub my_documents {
- $IMPLEMENTED_BY->can('my_documents')
- ? $IMPLEMENTED_BY->my_documents
- : Carp::croak("The my_documents method is not implemented on this platform");
-}
-
-sub my_music {
- $IMPLEMENTED_BY->can('my_music')
- ? $IMPLEMENTED_BY->my_music
- : Carp::croak("The my_music method is not implemented on this platform");
-}
-
-sub my_pictures {
- $IMPLEMENTED_BY->can('my_pictures')
- ? $IMPLEMENTED_BY->my_pictures
- : Carp::croak("The my_pictures method is not implemented on this platform");
-}
-
-sub my_videos {
- $IMPLEMENTED_BY->can('my_videos')
- ? $IMPLEMENTED_BY->my_videos
- : Carp::croak("The my_videos method is not implemented on this platform");
-}
-
-sub my_data {
- $IMPLEMENTED_BY->can('my_data')
- ? $IMPLEMENTED_BY->my_data
- : Carp::croak("The my_data method is not implemented on this platform");
-}
-
-
-
-
-
-#####################################################################
-# General User Methods
-
-sub users_home {
- $IMPLEMENTED_BY->can('users_home')
- ? $IMPLEMENTED_BY->users_home( $_[-1] )
- : Carp::croak("The users_home method is not implemented on this platform");
-}
-
-sub users_desktop {
- $IMPLEMENTED_BY->can('users_desktop')
- ? $IMPLEMENTED_BY->users_desktop( $_[-1] )
- : Carp::croak("The users_desktop method is not implemented on this platform");
-}
-
-sub users_documents {
- $IMPLEMENTED_BY->can('users_documents')
- ? $IMPLEMENTED_BY->users_documents( $_[-1] )
- : Carp::croak("The users_documents method is not implemented on this platform");
-}
-
-sub users_music {
- $IMPLEMENTED_BY->can('users_music')
- ? $IMPLEMENTED_BY->users_music( $_[-1] )
- : Carp::croak("The users_music method is not implemented on this platform");
-}
-
-sub users_pictures {
- $IMPLEMENTED_BY->can('users_pictures')
- ? $IMPLEMENTED_BY->users_pictures( $_[-1] )
- : Carp::croak("The users_pictures method is not implemented on this platform");
-}
-
-sub users_videos {
- $IMPLEMENTED_BY->can('users_videos')
- ? $IMPLEMENTED_BY->users_videos( $_[-1] )
- : Carp::croak("The users_videos method is not implemented on this platform");
-}
-
-sub users_data {
- $IMPLEMENTED_BY->can('users_data')
- ? $IMPLEMENTED_BY->users_data( $_[-1] )
- : Carp::croak("The users_data method is not implemented on this platform");
-}
-
-
-
-
-
-
-#####################################################################
-# Legacy Methods
-
-# Find the home directory of an arbitrary user
-sub home (;$) {
- # Allow to be called as a method
- if ( $_[0] and $_[0] eq 'File::HomeDir' ) {
- shift();
- }
-
- # No params means my home
- return my_home() unless @_;
-
- # Check the param
- my $name = shift;
- if ( ! defined $name ) {
- Carp::croak("Can't use undef as a username");
- }
- if ( ! length $name ) {
- Carp::croak("Can't use empty-string (\"\") as a username");
- }
-
- # A dot also means my home
- ### Is this meant to mean File::Spec->curdir?
- if ( $name eq '.' ) {
- return my_home();
- }
-
- # Now hand off to the implementor
- $IMPLEMENTED_BY->users_home($name);
-}
-
-
-
-
-
-#####################################################################
-# Tie-Based Interface
-
-# Okay, things below this point get scary
-
-CLASS: {
- # Make the class for the %~ tied hash:
- package File::HomeDir::TIE;
-
- # Make the singleton object.
- # (We don't use the hash for anything, though)
- ### THEN WHY MAKE IT???
- my $SINGLETON = bless {};
-
- sub TIEHASH { $SINGLETON }
-
- sub FETCH {
- # Catch a bad username
- unless ( defined $_[1] ) {
- Carp::croak("Can't use undef as a username");
- }
-
- # Get our homedir
- unless ( length $_[1] ) {
- return File::HomeDir::my_home();
- }
-
- # Get a named user's homedir
- return File::HomeDir::home($_[1]);
- }
-
- sub STORE { _bad('STORE') }
- sub EXISTS { _bad('EXISTS') }
- sub DELETE { _bad('DELETE') }
- sub CLEAR { _bad('CLEAR') }
- sub FIRSTKEY { _bad('FIRSTKEY') }
- sub NEXTKEY { _bad('NEXTKEY') }
-
- sub _bad ($) {
- Carp::croak("You can't $_[0] with the %~ hash")
- }
-}
-
-# Do the actual tie of the global %~ variable
-tie %~, 'File::HomeDir::TIE';
-
-1;
-
-__END__
-
-=pod
-
-=head1 NAME
-
-File::HomeDir - Find your home and other directories, on any platform
-
-=head1 SYNOPSIS
-
- use File::HomeDir;
-
- # Modern Interface (Current User)
- $home = File::HomeDir->my_home;
- $desktop = File::HomeDir->my_desktop;
- $docs = File::HomeDir->my_documents;
- $music = File::HomeDir->my_music;
- $pics = File::HomeDir->my_pictures;
- $videos = File::HomeDir->my_videos;
- $data = File::HomeDir->my_data;
-
- # Modern Interface (Other Users)
- $home = File::HomeDir->users_home('foo');
- $desktop = File::HomeDir->users_desktop('foo');
- $docs = File::HomeDir->users_documents('foo');
- $music = File::HomeDir->users_music('foo');
- $pics = File::HomeDir->users_pictures('foo');
- $video = File::HomeDir->users_videos('foo');
- $data = File::HomeDir->users_data('foo');
-
- # Legacy Interfaces
- print "My dir is ", home(), " and root's is ", home('root'), "\n";
- print "My dir is $~{''} and root's is $~{root}\n";
- # These both print the same thing, something like:
- # "My dir is /home/user/mojo and root's is /"
-
-=head1 DESCRIPTION
-
-B<File::HomeDir> is a module for dealing with issues relating to the
-location of directories that are "owned" by a user, primarily your user,
-and to solve these issues consistently across a wide variety of
-platforms.
-
-Thus, a single API is presented that can find your resources on any
-platform.
-
-This module provides two main interfaces.
-
-The first is a modern L<File::Spec>-style interface with a consistent
-OO API and different implementation modules to support various
-platforms. You are B<strongly> recommended to use this interface.
-
-The second interface is for legacy support of the original 0.07 interface
-that exported a C<home()> function by default and tied the C<%~> variable.
-
-It is generally not recommended that you use this interface, but due to
-back-compatibility reasons they will remain supported until at least 2010.
-
-After this date, the home() function will remain, but we will consider
-deprecating the (namespace-polluting) C<%~> tied hash, to be removed by
-2015 (maintaining the general Perl convention of a 10 year support period
-for legacy APIs potentially or actually in common use).
-
-=head2 Platform Neutrality
-
-In the Unix world, many different types of data can be mixed together
-in your home directory (although on some Unix platforms this is no longer
-the case, particularly for "desktop"-oriented platforms).
-
-On some non-Unix platforms, seperate directories are allocated for
-different types of data and have been for a long time.
-
-When writing applications on top of B<File::HomeDir>, you should thus
-always try to use the most specific method you can. User documents should
-be saved in C<my_documents>, data that supports an application but isn't
-normally editing by the user directory should go into C<my_data>.
-
-On platforms that do not make any distinction, all these different
-methods will harmlessly degrade to the main home directory, but on
-platforms that care B<File::HomeDir> will always try to Do The Right
-Thing(tm).
-
-=head1 METHODS
-
-Two types of methods are provided. The C<my_method> series of methods for
-finding resources for the current user, and the C<users_method> (read as
-"user's method") series for finding resources for arbitrary users.
-
-This split is necesary, as on most platforms it is B<much> easier to find
-information about the current user compared to other users, and indeed
-on a number you cannot find out information such as C<users_desktop> at
-all, due to security restrictions.
-
-All methods will double check (using a C<-d> test) that a directory
-actually exists before returning it, so you may trust in the values
-that are returned (subject to the usual caveats of race conditions of
-directories being deleted at the moment between a directory being returned
-and you using it).
-
-However, because in some cases platforms may not support the concept of home
-directories at all, any method may return C<undef> (both in scalar and list
-context) to indicate that there is no matching directory on the system.
-
-For example, most untrusted 'nobody'-type users do not have a home
-directory. So any modules that are used in a CGI application that
-at some level of recursion use your code, will result in calls to
-File::HomeDir returning undef, even for a basic home() call.
-
-=head2 my_home
-
-The C<my_home> method takes no arguments and returns the main home/profile
-directory for the current user.
-
-If the distinction is important to you, the term "current" refers to the
-real user, and not the effective user.
-
-This is also the case for all of the other "my" methods.
-
-Returns the directory path as a string, C<undef> if the current user
-does not have a home directory, or dies on error.
-
-=head2 my_desktop
-
-The C<my_desktop> method takes no arguments and returns the "desktop"
-directory for the current user.
-
-Due to the diversity and complexity of implementions required to deal with
-implementing the required functionality fully and completely, for the moment
-C<my_desktop> is B<not> going to be implemented.
-
-That said, I am extremely interested in code to implement C<my_desktop> on
-Unix, as long as it is capable of dealing (as the Windows implementation
-does) with internationalisation. It should also avoid false positive
-results by making sure it only returns the appropriate directories for the
-appropriate platforms.
-
-Returns the directory path as a string, C<undef> if the current user
-does not have a desktop directory, or dies on error.
-
-=head2 my_documents
-
-The C<my_documents> method takes no arguments and returns the directory (for
-the current user) where the user's documents are stored.
-
-Returns the directory path as a string, C<undef> if the current user
-does not have a documents directory, or dies on error.
-
-=head2 my_music
-
-The C<my_music> method takes no arguments and returns the directory
-where the current user's music is stored.
-
-No bias is made to any particular music type or music program, rather the
-concept of a directory to hold the user's music is made at the level of the
-underlying operating system or (at least) desktop environment.
-
-Returns the directory path as a string, C<undef> if the current user
-does not have a suitable directory, or dies on error.
-
-=head2 my_pictures
-
-The C<my_pictures> method takes no arguments and returns the directory
-where the current user's pictures are stored.
-
-No bias is made to any particular picture type or picture program, rather the
-concept of a directory to hold the user's pictures is made at the level of the
-underlying operating system or (at least) desktop environment.
-
-Returns the directory path as a string, C<undef> if the current user
-does not have a suitable directory, or dies on error.
-
-=head2 my_videos
-
-The C<my_videos> method takes no arguments and returns the directory
-where the current user's videos are stored.
-
-No bias is made to any particular video type or video program, rather the
-concept of a directory to hold the user's videos is made at the level of the
-underlying operating system or (at least) desktop environment.
-
-Returns the directory path as a string, C<undef> if the current user
-does not have a suitable directory, or dies on error.
-
-=head2 my_data
-
-The C<my_data> method takes no arguments and returns the directory where
-local applications should stored their internal data for the current
-user.
-
-Generally an application would create a subdirectory such as C<.foo>,
-beneath this directory, and store its data there. By creating your
-directory this way, you get an accurate result on the maximum number
-of platforms.
-
-For example, on Unix you get C<~/.foo> and on Win32 you get
-C<~/Local Settings/Application Data/.foo>
-
-Returns the directory path as a string, C<undef> if the current user
-does not have a data directory, or dies on error.
-
-=head2 users_home
-
- $home = File::HomeDir->users_home('foo');
-
-The C<users_home> method takes a single param and is used to locate the
-parent home/profile directory for an identified user on the system.
-
-While most of the time this identifier would be some form of user name,
-it is permitted to vary per-platform to support user ids or UUIDs as
-applicable for that platform.
-
-Returns the directory path as a string, C<undef> if that user
-does not have a home directory, or dies on error.
-
-=head2 users_documents
-
- $docs = File::HomeDir->users_documents('foo');
-
-Returns the directory path as a string, C<undef> if that user
-does not have a documents directory, or dies on error.
-
-=head2 users_data
-
- $data = File::HomeDir->users_data('foo');
-
-Returns the directory path as a string, C<undef> if that user
-does not have a data directory, or dies on error.
-
-=head1 FUNCTIONS
-
-=head2 home
-
- use File::HomeDir;
- $home = home();
- $home = home('foo');
- $home = File::HomeDir::home();
- $home = File::HomeDir::home('foo');
-
-The C<home> function is exported by default and is provided for
-compatibility with legacy applications. In new applications, you should
-use the newer method-based interface above.
-
-Returns the directory path to a named user's home/profile directory.
-
-If provided no param, returns the directory path to the current user's
-home/profile directory.
-
-=head1 TIED INTERFACE
-
-=head2 %~
-
- $home = $~{""};
- $home = $~{undef};
- $home = $~{$user};
- $home = $~{username};
- print "... $~{''} ...";
- print "... $~{$user} ...";
- print "... $~{username} ...";
-
-This calls C<home($user)> or C<home('username')> -- except that if you
-ask for C<$~{some_user}> and there is no such user, it will die.
-
-Note that this is especially useful in double-quotish strings, like:
-
- print "Jojo's .newsrc is ", -s "$~{jojo}/.newsrc", "b long!\n";
- # (helpfully dies if there is no user 'jojo')
-
-If you want to avoid the fatal errors, first test the value of
-C<home('jojo')>, which will return undef (instead of dying) in case of
-there being no such user.
-
-Note, however, that if the hash key is "" or undef (whether thru being
-a literal "", or a scalar whose value is empty-string or undef), then
-this returns zero-argument C<home()>, i.e., your home directory:
-
-Further, please note that because the C<%~> hash compulsorily modifies
-a hash outside of it's namespace, and presents an overly simplistic
-approach to home directories, it is likely to ultimately be removed.
-
-The interface is currently expected to be formally deprecated from 2010
-(but no earlier) and removed from 2015 (but no earlier). If very heavy
-use is found in the wild, these plans may be pushed back.
-
-=head1 TO DO
-
-=over 4
-
-=item * Become generally clearer on situations in which a user might not
-have a particular resource.
-
-=item * Merge remaining edge case code in L<File::HomeDir::Win32>
-
-=item * Add more granularity to Unix, and add support to VMS and other
-esoteric platforms, so we can consider going core.
-
-=item * Add consistent support for users_* methods
-
-=back
-
-=head1 SUPPORT
-
-This module is stored in an Open Repository at the following address.
-
-L<http://svn.ali.as/cpan/trunk/File-HomeDir>
-
-Write access to the repository is made available automatically to any
-published CPAN author, and to most other volunteers on request.
-
-If you are able to submit your bug report in the form of new (failing)
-unit tests, or can apply your fix directly instead of submitting a patch,
-you are B<strongly> encouraged to do so as the author currently maintains
-over 100 modules and it can take some time to deal with non-Critical bug
-reports or patches.
-
-This will guarantee that your issue will be addressed in the next
-release of the module.
-
-If you cannot provide a direct test or fix, or don't have time to do so,
-then regular bug reports are still accepted and appreciated via the CPAN
-bug tracker.
-
-L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=File-HomeDir>
-
-For other issues, for commercial enhancement or support, or to have your
-write access enabled for the repository, contact the author at the email
-address above.
-
-=head1 ACKNOWLEDGEMENTS
-
-The biggest acknowledgement must go to Chris Nandor, who wielded his
-legendary Mac-fu and turned my initial fairly ordinary Darwin
-implementation into something that actually worked properly everywhere,
-and then donated a Mac OS X license to allow it to be maintained properly.
-
-=head1 AUTHORS
-
-Adam Kennedy E<lt>adamk@cpan.orgE<gt>
-
-Sean M. Burke E<lt>sburke@cpan.orgE<gt>
-
-Chris Nandor E<lt>cnandor@cpan.orgE<gt>
-
-Stephen Steneker E<lt>stennie@cpan.orgE<gt>
-
-=head1 SEE ALSO
-
-L<File::ShareDir>, L<File::HomeDir::Win32> (legacy)
-
-=head1 COPYRIGHT
-
-Copyright 2005 - 2008 Adam Kennedy.
-
-Some parts copyright 2000 Sean M. Burke.
-
-Some parts copyright 2006 Chris Nandor.
-
-Some parts copyright 2006 Stephen Steneker.
-
-This program is free software; you can redistribute
-it and/or modify it under the same terms as Perl itself.
-
-The full text of the license can be found in the
-LICENSE file included with this module.
-
-=cut
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/File/HomeDir/Darwin.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/File/HomeDir/Darwin.pm
deleted file mode 100644
index 70085f967f8..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/File/HomeDir/Darwin.pm
+++ /dev/null
@@ -1,185 +0,0 @@
-package File::HomeDir::Darwin;
-
-# Basic implementation for the Dawin family of operating systems.
-# This includes (most prominently) Mac OS X.
-
-use 5.005;
-use strict;
-use File::HomeDir::Unix ();
-use Carp ();
-use Cwd ();
-
-use vars qw{$VERSION @ISA};
-BEGIN {
- $VERSION = '0.80';
- @ISA = 'File::HomeDir::Unix';
-}
-
-# Load early if in a forking environment and we have
-# prefork, or at run-time if not.
-SCOPE: {
- local $@;
- eval "use prefork 'Mac::Files'";
-}
-
-
-
-
-
-#####################################################################
-# Current User Methods
-
-sub my_home {
- my ($class) = @_;
- require Mac::Files;
- $class->_find_folder(
- Mac::Files::kCurrentUserFolderType(),
- );
-}
-
-sub my_desktop {
- my ($class) = @_;
- require Mac::Files;
- $class->_find_folder(
- Mac::Files::kDesktopFolderType(),
- );
-}
-
-sub my_documents {
- my ($class) = @_;
- require Mac::Files;
- $class->_find_folder(
- Mac::Files::kDocumentsFolderType(),
- );
-}
-
-sub my_data {
- my ($class) = @_;
- require Mac::Files;
- $class->_find_folder(
- Mac::Files::kApplicationSupportFolderType(),
- );
-}
-
-sub my_music {
- my ($class) = @_;
- require Mac::Files;
- $class->_find_folder(
- Mac::Files::kMusicDocumentsFolderType(),
- );
-}
-
-sub my_pictures {
- my ($class) = @_;
- require Mac::Files;
- $class->_find_folder(
- Mac::Files::kPictureDocumentsFolderType(),
- );
-}
-
-sub my_videos {
- my ($class) = @_;
- require Mac::Files;
- $class->_find_folder(
- Mac::Files::kMovieDocumentsFolderType(),
- );
-}
-
-sub _find_folder {
- my ($class, $name) = @_;
- require Mac::Files;
- my $folder = Mac::Files::FindFolder(
- Mac::Files::kUserDomain(),
- $name,
- );
- return unless defined $folder;
- unless ( -d $folder ) {
- # Make sure that symlinks resolve to directories.
- return unless -l $folder;
- my $dir = readlink $folder or return;
- return unless -d $dir;
- }
- return Cwd::abs_path($folder);
-}
-
-
-
-
-
-#####################################################################
-# Arbitrary User Methods
-
-sub users_home {
- my $class = shift;
- my $home = $class->SUPER::users_home(@_);
- return Cwd::abs_path($home);
-}
-
-# in theory this can be done, but for now, let's cheat, since the
-# rest is Hard
-sub users_desktop {
- my ($class, $name) = @_;
- return undef if $name eq 'root';
- $class->_to_user( $class->my_desktop, $name );
-}
-
-sub users_documents {
- my ($class, $name) = @_;
- return undef if $name eq 'root';
- $class->_to_user( $class->my_documents, $name );
-}
-
-sub users_data {
- my ($class, $name) = @_;
- $class->_to_user( $class->my_data, $name )
- || $class->users_home($name);
-}
-
-# cheap hack ... not entirely reliable, perhaps, but ... c'est la vie, since
-# there's really no other good way to do it at this time, that i know of -- pudge
-sub _to_user {
- my ($class, $path, $name) = @_;
- my $my_home = $class->my_home;
- my $users_home = $class->users_home($name);
- $path =~ s/^Q$my_home/$users_home/;
- return $path;
-}
-
-1;
-
-=pod
-
-=head1 NAME
-
-File::HomeDir::Darwin - find your home and other directories, on Darwin (OS X)
-
-=head1 DESCRIPTION
-
-This module provides Darwin-specific implementations for determining
-common user directories. In normal usage this module will always be
-used via L<File::HomeDir>.
-
-=head1 SYNOPSIS
-
- use File::HomeDir;
-
- # Find directories for the current user
- $home = File::HomeDir->my_home; # /Users/mylogin
- $desktop = File::HomeDir->my_desktop; # /Users/mylogin/Desktop
- $docs = File::HomeDir->my_documents; # /Users/mylogin/Documents
- $music = File::HomeDir->my_music; # /Users/mylogin/Music
- $pics = File::HomeDir->my_pictures; # /Users/mylogin/Pictures
- $videos = File::HomeDir->my_videos; # /Users/mylogin/Movies
- $data = File::HomeDir->my_data; # /Users/mylogin/Library/Application Support
-
-=head1 TODO
-
-=over 4
-
-=item * Fallback to Unix if no Mac::Carbon available
-
-=item * Test with Mac OS (versions 7, 8, 9)
-
-=item * Some better way for users_* ?
-
-=back
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/File/HomeDir/Driver.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/File/HomeDir/Driver.pm
deleted file mode 100644
index 55002d8219c..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/File/HomeDir/Driver.pm
+++ /dev/null
@@ -1,19 +0,0 @@
-package File::HomeDir::Driver;
-
-# Abstract base class that provides no functionality,
-# but confirms the class is a File::HomeDir driver class.
-
-use 5.005;
-use strict;
-use Carp ();
-
-use vars qw{$VERSION};
-BEGIN {
- $VERSION = '0.80';
-}
-
-sub my_home {
- Carp::croak("$_[0] does not implement compulsory method $_[1]");
-}
-
-1;
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/File/HomeDir/MacOS9.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/File/HomeDir/MacOS9.pm
deleted file mode 100644
index fdbc75cb836..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/File/HomeDir/MacOS9.pm
+++ /dev/null
@@ -1,94 +0,0 @@
-package File::HomeDir::MacOS9;
-
-# Half-assed implementation for the legacy Mac OS9 operating system.
-# Provided mainly to provide legacy compatibility. May be removed at
-# a later date.
-
-use 5.005;
-use strict;
-use File::HomeDir::Driver ();
-use Carp ();
-
-use vars qw{$VERSION @ISA};
-BEGIN {
- $VERSION = '0.80';
- @ISA = 'File::HomeDir::Driver';
-}
-
-# Load early if in a forking environment and we have
-# prefork, or at run-time if not.
-SCOPE: {
- local $@;
- eval "use prefork 'Mac::Files'";
-}
-
-
-
-
-
-#####################################################################
-# Current User Methods
-
-sub my_home {
- my $class = shift;
-
- # Try for $ENV{HOME} if we have it
- if ( defined $ENV{HOME} ) {
- return $ENV{HOME};
- }
-
- ### DESPERATION SETS IN
-
- # We could use the desktop
- eval {
- my $home = $class->my_desktop;
- return $home if $home and -d $home;
- };
-
- # Desperation on any platform
- SCOPE: {
- # On some platforms getpwuid dies if called at all
- local $SIG{'__DIE__'} = '';
- my $home = (getpwuid($<))[7];
- return $home if $home and -d $home;
- }
-
- Carp::croak("Could not locate current user's home directory");
-}
-
-sub my_desktop {
- my $class = shift;
-
- # Find the desktop via Mac::Files
- local $SIG{'__DIE__'} = '';
- require Mac::Files;
- my $home = Mac::Files::FindFolder(
- Mac::Files::kOnSystemDisk(),
- Mac::Files::kDesktopFolderType(),
- );
- return $home if $home and -d $home;
-
- Carp::croak("Could not locate current user's desktop");
-}
-
-
-
-
-
-#####################################################################
-# General User Methods
-
-sub users_home {
- my ($class, $name) = @_;
-
- SCOPE: {
- # On some platforms getpwnam dies if called at all
- local $SIG{'__DIE__'} = '';
- my $home = (getpwnam($name))[7];
- return $home if defined $home and -d $home;
- }
-
- Carp::croak("Failed to find home directory for user '$name'");
-}
-
-1;
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/File/HomeDir/Unix.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/File/HomeDir/Unix.pm
deleted file mode 100644
index 6610bc455d3..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/File/HomeDir/Unix.pm
+++ /dev/null
@@ -1,167 +0,0 @@
-package File::HomeDir::Unix;
-
-# Unix-specific functionality
-
-use 5.005;
-use strict;
-use File::HomeDir::Driver ();
-use Carp ();
-
-use vars qw{$VERSION @ISA};
-BEGIN {
- $VERSION = '0.80';
- @ISA = 'File::HomeDir::Driver';
-}
-
-
-
-
-
-#####################################################################
-# Current User Methods
-
-sub my_home {
- my $class = shift;
- my $home = $class->_my_home(@_);
-
- # On Unix in general, a non-existant home means "no home"
- # For example, "nobody"-like users might use /nonexistant
- if ( defined $home and ! -d $home ) {
- $home = undef;
- }
-
- return $home;
-}
-
-sub _my_home {
- my $class = shift;
- if ( exists $ENV{HOME} and defined $ENV{HOME} ) {
- return $ENV{HOME};
- }
-
- # This is from the original code, but I'm guessing
- # it means "login directory" and exists on some Unixes.
- if ( exists $ENV{LOGDIR} and $ENV{LOGDIR} ) {
- return $ENV{LOGDIR};
- }
-
- ### More-desperate methods
-
- # Light desperation on any (Unixish) platform
- SCOPE: {
- my $home = (getpwuid($<))[7];
- return $home if $home and -d $home;
- }
-
- return undef;
-}
-
-# On unix by default, everything is under the same folder
-sub my_desktop {
- shift->my_home;
-}
-
-sub my_documents {
- shift->my_home;
-}
-
-sub my_data {
- shift->my_home;
-}
-
-sub my_music {
- shift->my_home;
-}
-
-sub my_pictures {
- shift->my_home;
-}
-
-sub my_videos {
- shift->my_home;
-}
-
-
-
-
-
-#####################################################################
-# General User Methods
-
-sub users_home {
- my ($class, $name) = @_;
-
- # IF and only if we have getpwuid support, and the
- # name of the user is our own, shortcut to my_home.
- # This is needed to handle HOME environment settings.
- if ( $name eq getpwuid($<) ) {
- return $class->my_home;
- }
-
- SCOPE: {
- my $home = (getpwnam($name))[7];
- return $home if $home and -d $home;
- }
-
- return undef;
-}
-
-sub users_desktop {
- shift->users_home(@_);
-}
-
-sub users_documents {
- shift->users_home(@_);
-}
-
-sub users_data {
- shift->users_home(@_);
-}
-
-sub users_music {
- shift->users_home(@_);
-}
-
-sub users_pictures {
- shift->users_home(@_);
-}
-
-sub users_videos {
- shift->users_home(@_);
-}
-
-1;
-
-=pod
-
-=head1 NAME
-
-File::HomeDir::Unix - find your home and other directories, on Unix
-
-=head1 DESCRIPTION
-
-This module provides implementations for determining common user
-directories. In normal usage this module will always be
-used via L<File::HomeDir>.
-
-=head1 SYNOPSIS
-
- use File::HomeDir;
-
- # Find directories for the current user
- $home = File::HomeDir->my_home; # /home/mylogin
-
- $desktop = File::HomeDir->my_desktop; # All of these will...
- $docs = File::HomeDir->my_documents; # ...default to home...
- $music = File::HomeDir->my_music; # ...directory at the...
- $pics = File::HomeDir->my_pictures; # ...moment.
- $videos = File::HomeDir->my_videos; #
- $data = File::HomeDir->my_data; #
-
-=head1 TODO
-
-=over 4
-
-=item * Add support for common unix desktop and data directories when using KDE / Gnome / ...
-
-=back
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/File/HomeDir/Windows.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/File/HomeDir/Windows.pm
deleted file mode 100644
index 18d10c036a0..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/File/HomeDir/Windows.pm
+++ /dev/null
@@ -1,176 +0,0 @@
-package File::HomeDir::Windows;
-
-# Generalised implementation for the entire Windows family of operating
-# systems.
-
-use 5.005;
-use strict;
-use File::HomeDir::Driver ();
-use Carp ();
-use File::Spec ();
-
-use vars qw{$VERSION @ISA};
-BEGIN {
- $VERSION = '0.80';
- @ISA = 'File::HomeDir::Driver';
-}
-
-sub CREATE () { 1 }
-
-
-
-
-
-#####################################################################
-# Current User Methods
-
-sub my_home {
- my $class = shift;
-
- # A lot of unix people and unix-derived tools rely on
- # the ability to overload HOME. We will support it too
- # so that they can replace raw HOME calls with File::HomeDir.
- if ( exists $ENV{HOME} and $ENV{HOME} ) {
- return $ENV{HOME};
- }
-
- # Do we have a user profile?
- if ( exists $ENV{USERPROFILE} and $ENV{USERPROFILE} ) {
- return $ENV{USERPROFILE};
- }
-
- # Some Windows use something like $ENV{HOME}
- if ( exists $ENV{HOMEDRIVE} and exists $ENV{HOMEPATH} and $ENV{HOMEDRIVE} and $ENV{HOMEPATH} ) {
- return File::Spec->catpath(
- $ENV{HOMEDRIVE}, $ENV{HOMEPATH}, '',
- );
- }
-
- return undef;
-}
-
-sub my_desktop {
- my $class = shift;
-
- # The most correct way to find the desktop
- SCOPE: {
- require Win32;
- my $dir = Win32::GetFolderPath(Win32::CSIDL_DESKTOP(), CREATE);
- return $dir if $dir and -d $dir;
- }
-
- # MSWindows sets WINDIR, MS WinNT sets USERPROFILE.
- foreach my $e ( 'USERPROFILE', 'WINDIR' ) {
- next unless $ENV{$e};
- my $desktop = File::Spec->catdir($ENV{$e}, 'Desktop');
- return $desktop if $desktop and -d $desktop;
- }
-
- # As a last resort, try some hard-wired values
- foreach my $fixed (
- # The reason there are both types of slash here is because
- # this set of paths has been kept from thethe original version
- # of File::HomeDir::Win32 (before it was rewritten).
- # I can only assume this is Cygwin-related stuff.
- "C:\\windows\\desktop",
- "C:\\win95\\desktop",
- "C:/win95/desktop",
- "C:/windows/desktop",
- ) {
- return $fixed if -d $fixed;
- }
-
- return undef;
-}
-
-sub my_documents {
- my $class = shift;
-
- # The most correct way to find my documents
- SCOPE: {
- require Win32;
- my $dir = Win32::GetFolderPath(Win32::CSIDL_PERSONAL(), CREATE);
- return $dir if $dir and -d $dir;
- }
-
- return undef;
-}
-
-sub my_data {
- my $class = shift;
-
- # The most correct way to find my documents
- SCOPE: {
- require Win32;
- my $dir = Win32::GetFolderPath(Win32::CSIDL_LOCAL_APPDATA(), CREATE);
- return $dir if $dir and -d $dir;
- }
-
- return undef;
-}
-
-sub my_music {
- my $class = shift;
-
- # The most correct way to find my music
- SCOPE: {
- require Win32;
- my $dir = Win32::GetFolderPath(Win32::CSIDL_MYMUSIC(), CREATE);
- return $dir if $dir and -d $dir;
- }
-
- return undef;
-}
-
-sub my_pictures {
- my $class = shift;
-
- # The most correct way to find my pictures
- SCOPE: {
- require Win32;
- my $dir = Win32::GetFolderPath(Win32::CSIDL_MYPICTURES(), CREATE);
- return $dir if $dir and -d $dir;
- }
-
- return undef;
-}
-
-sub my_videos {
- my $class = shift;
-
- # The most correct way to find my videos
- SCOPE: {
- require Win32;
- my $dir = Win32::GetFolderPath(Win32::CSIDL_MYVIDEO(), CREATE);
- return $dir if $dir and -d $dir;
- }
-
- return undef;
-}
-
-1;
-
-=pod
-
-=head1 NAME
-
-File::HomeDir::Windows - find your home and other directories, on Windows
-
-=head1 DESCRIPTION
-
-This module provides Windows-specific implementations for determining
-common user directories. In normal usage this module will always be
-used via L<File::HomeDir>.
-
-=head1 SYNOPSIS
-
- use File::HomeDir;
-
- # Find directories for the current user (eg. using Windows XP Professional)
- $home = File::HomeDir->my_home; # C:\Documents and Settings\mylogin
- $desktop = File::HomeDir->my_desktop; # C:\Documents and Settings\mylogin\Desktop
- $docs = File::HomeDir->my_documents; # C:\Documents and Settings\mylogin\My Documents
- $music = File::HomeDir->my_music; # C:\Documents and Settings\mylogin\My Documents\My Music
- $pics = File::HomeDir->my_pictures; # C:\Documents and Settings\mylogin\My Documents\My Pictures
- $videos = File::HomeDir->my_videos; # C:\Documents and Settings\mylogin\My Documents\My Video
- $data = File::HomeDir->my_data; # C:\Documents and Settings\mylogin\Local Settings\Application Data
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/File/Listing.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/File/Listing.pm
deleted file mode 100644
index 1c1b6fbdfb2..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/File/Listing.pm
+++ /dev/null
@@ -1,409 +0,0 @@
-package File::Listing;
-
-sub Version { $VERSION; }
-$VERSION = "5.810";
-
-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 ($)
-{
- # This routine was originally borrowed from Graham Barr's
- # Net::FTP package.
-
- local $_ = shift;
- my $mode = 0;
- my($type,$ch);
-
- s/^(.)// and $type = $1;
-
- while (/(.)/g) {
- $mode <<= 1;
- $mode |= 1 if $1 ne "-" &&
- $1 ne 'S' &&
- $1 ne 't' &&
- $1 ne 'T';
- }
-
- $type eq "d" and $mode |= 0040000 or # Directory
- $type eq "l" and $mode |= 0120000 or # Symbolic Link
- $mode |= 0100000; # Regular File
-
- $mode |= 0004000 if /^...s....../i;
- $mode |= 0002000 if /^......s.../i;
- $mode |= 0001000 if /^.........t/i;
-
- $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);
-no strict qw(vars);
-
-@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})) # 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
- 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);
-no strict qw(vars);
-
-@ISA = qw(File::Listing);
-
-
-
-sub init
-{
- $curdir = '';
-}
-
-
-sub line
-{
- shift; # package name
- local($_) = shift;
- my($tz, $error) = @_;
-
- s/\015//g;
-
- my ($kind, $size, $date, $name);
-
- # 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),
- File::Listing::file_mode($kind)];
-
- }
- 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;
-
-@ISA = qw(File::Listing);
-
-
-sub init { }
-
-
-sub line {
- shift; # package name
- local($_) = shift;
- my($tz, $error) = @_; # ignored for now...
-
- if (m!<A\s+HREF=\"([^\"]+)\">.*</A>.*?(\d+)-([a-zA-Z]+)-(\d+)\s+(\d+):(\d+)\s+(?:([\d\.]+[kM]?|-))!i) {
- my($filename, $filesize) = ($1, $7);
- my($d,$m,$y, $H,$M) = ($2,$3,$4,$5,$6);
-
- $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,_monthabbrev_number($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);
- 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. Currently it only understand Unix
-C<'ls -l'> and C<'ls -lR'> format. It should eventually be able to
-most things you might get back from a ftp server file listing (LIST
-command), i.e. VMS listings, NT listings, DOS 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. The values will
-be strings like 'unix', 'vms', 'dos'. Currently only 'unix' is
-implemented and this is also the default value. 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 CREDITS
-
-Based on lsparse.pl (from Lee McLoughlin's ftp mirror package) and
-Net::FTP's parse_dir (Graham Barr).
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/File/Temp.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/File/Temp.pm
deleted file mode 100644
index 120b5325101..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/File/Temp.pm
+++ /dev/null
@@ -1,2425 +0,0 @@
-package File::Temp;
-
-=head1 NAME
-
-File::Temp - return name and handle of a temporary file safely
-
-=begin __INTERNALS
-
-=head1 PORTABILITY
-
-This section is at the top in order to provide easier access to
-porters. It is not expected to be rendered by a standard pod
-formatting tool. Please skip straight to the SYNOPSIS section if you
-are not trying to port this module to a new platform.
-
-This module is designed to be portable across operating systems and it
-currently supports Unix, VMS, DOS, OS/2, Windows and Mac OS
-(Classic). When porting to a new OS there are generally three main
-issues that have to be solved:
-
-=over 4
-
-=item *
-
-Can the OS unlink an open file? If it can not then the
-C<_can_unlink_opened_file> method should be modified.
-
-=item *
-
-Are the return values from C<stat> reliable? By default all the
-return values from C<stat> are compared when unlinking a temporary
-file using the filename and the handle. Operating systems other than
-unix do not always have valid entries in all fields. If C<unlink0> fails
-then the C<stat> comparison should be modified accordingly.
-
-=item *
-
-Security. Systems that can not support a test for the sticky bit
-on a directory can not use the MEDIUM and HIGH security tests.
-The C<_can_do_level> method should be modified accordingly.
-
-=back
-
-=end __INTERNALS
-
-=head1 SYNOPSIS
-
- use File::Temp qw/ tempfile tempdir /;
-
- $fh = tempfile();
- ($fh, $filename) = tempfile();
-
- ($fh, $filename) = tempfile( $template, DIR => $dir);
- ($fh, $filename) = tempfile( $template, SUFFIX => '.dat');
- ($fh, $filename) = tempfile( $template, TMPDIR => 1 );
-
- binmode( $fh, ":utf8" );
-
- $dir = tempdir( CLEANUP => 1 );
- ($fh, $filename) = tempfile( DIR => $dir );
-
-Object interface:
-
- require File::Temp;
- use File::Temp ();
- use File::Temp qw/ :seekable /;
-
- $fh = File::Temp->new();
- $fname = $fh->filename;
-
- $fh = File::Temp->new(TEMPLATE => $template);
- $fname = $fh->filename;
-
- $tmp = File::Temp->new( UNLINK => 0, SUFFIX => '.dat' );
- print $tmp "Some data\n";
- print "Filename is $tmp\n";
- $tmp->seek( 0, SEEK_END );
-
-The following interfaces are provided for compatibility with
-existing APIs. They should not be used in new code.
-
-MkTemp family:
-
- use File::Temp qw/ :mktemp /;
-
- ($fh, $file) = mkstemp( "tmpfileXXXXX" );
- ($fh, $file) = mkstemps( "tmpfileXXXXXX", $suffix);
-
- $tmpdir = mkdtemp( $template );
-
- $unopened_file = mktemp( $template );
-
-POSIX functions:
-
- use File::Temp qw/ :POSIX /;
-
- $file = tmpnam();
- $fh = tmpfile();
-
- ($fh, $file) = tmpnam();
-
-Compatibility functions:
-
- $unopened_file = File::Temp::tempnam( $dir, $pfx );
-
-=head1 DESCRIPTION
-
-C<File::Temp> can be used to create and open temporary files in a safe
-way. There is both a function interface and an object-oriented
-interface. The File::Temp constructor or the tempfile() function can
-be used to return the name and the open filehandle of a temporary
-file. The tempdir() function can be used to create a temporary
-directory.
-
-The security aspect of temporary file creation is emphasized such that
-a filehandle and filename are returned together. This helps guarantee
-that a race condition can not occur where the temporary file is
-created by another process between checking for the existence of the
-file and its opening. Additional security levels are provided to
-check, for example, that the sticky bit is set on world writable
-directories. See L<"safe_level"> for more information.
-
-For compatibility with popular C library functions, Perl implementations of
-the mkstemp() family of functions are provided. These are, mkstemp(),
-mkstemps(), mkdtemp() and mktemp().
-
-Additionally, implementations of the standard L<POSIX|POSIX>
-tmpnam() and tmpfile() functions are provided if required.
-
-Implementations of mktemp(), tmpnam(), and tempnam() are provided,
-but should be used with caution since they return only a filename
-that was valid when function was called, so cannot guarantee
-that the file will not exist by the time the caller opens the filename.
-
-Filehandles returned by these functions support the seekable methods.
-
-=cut
-
-# 5.6.0 gives us S_IWOTH, S_IWGRP, our and auto-vivifying filehandls
-# People would like a version on 5.004 so give them what they want :-)
-use 5.004;
-use strict;
-use Carp;
-use File::Spec 0.8;
-use File::Path qw/ rmtree /;
-use Fcntl 1.03;
-use IO::Seekable; # For SEEK_*
-use Errno;
-require VMS::Stdio if $^O eq 'VMS';
-
-# pre-emptively load Carp::Heavy. If we don't when we run out of file
-# handles and attempt to call croak() we get an error message telling
-# us that Carp::Heavy won't load rather than an error telling us we
-# have run out of file handles. We either preload croak() or we
-# switch the calls to croak from _gettemp() to use die.
-eval { require Carp::Heavy; };
-
-# Need the Symbol package if we are running older perl
-require Symbol if $] < 5.006;
-
-### For the OO interface
-use base qw/ IO::Handle IO::Seekable /;
-use overload '""' => "STRINGIFY", fallback => 1;
-
-# use 'our' on v5.6.0
-use vars qw($VERSION @EXPORT_OK %EXPORT_TAGS $DEBUG $KEEP_ALL);
-
-$DEBUG = 0;
-$KEEP_ALL = 0;
-
-# We are exporting functions
-
-use base qw/Exporter/;
-
-# Export list - to allow fine tuning of export table
-
-@EXPORT_OK = qw{
- tempfile
- tempdir
- tmpnam
- tmpfile
- mktemp
- mkstemp
- mkstemps
- mkdtemp
- unlink0
- cleanup
- SEEK_SET
- SEEK_CUR
- SEEK_END
- };
-
-# Groups of functions for export
-
-%EXPORT_TAGS = (
- 'POSIX' => [qw/ tmpnam tmpfile /],
- 'mktemp' => [qw/ mktemp mkstemp mkstemps mkdtemp/],
- 'seekable' => [qw/ SEEK_SET SEEK_CUR SEEK_END /],
- );
-
-# add contents of these tags to @EXPORT
-Exporter::export_tags('POSIX','mktemp','seekable');
-
-# Version number
-
-$VERSION = '0.20';
-
-# This is a list of characters that can be used in random filenames
-
-my @CHARS = (qw/ A B C D E F G H I J K L M N O P Q R S T U V W X Y Z
- a b c d e f g h i j k l m n o p q r s t u v w x y z
- 0 1 2 3 4 5 6 7 8 9 _
- /);
-
-# Maximum number of tries to make a temp file before failing
-
-use constant MAX_TRIES => 1000;
-
-# Minimum number of X characters that should be in a template
-use constant MINX => 4;
-
-# Default template when no template supplied
-
-use constant TEMPXXX => 'X' x 10;
-
-# Constants for the security level
-
-use constant STANDARD => 0;
-use constant MEDIUM => 1;
-use constant HIGH => 2;
-
-# OPENFLAGS. If we defined the flag to use with Sysopen here this gives
-# us an optimisation when many temporary files are requested
-
-my $OPENFLAGS = O_CREAT | O_EXCL | O_RDWR;
-my $LOCKFLAG;
-
-unless ($^O eq 'MacOS') {
- for my $oflag (qw/ NOFOLLOW BINARY LARGEFILE NOINHERIT /) {
- my ($bit, $func) = (0, "Fcntl::O_" . $oflag);
- no strict 'refs';
- $OPENFLAGS |= $bit if eval {
- # Make sure that redefined die handlers do not cause problems
- # e.g. CGI::Carp
- local $SIG{__DIE__} = sub {};
- local $SIG{__WARN__} = sub {};
- $bit = &$func();
- 1;
- };
- }
- # Special case O_EXLOCK
- $LOCKFLAG = eval {
- local $SIG{__DIE__} = sub {};
- local $SIG{__WARN__} = sub {};
- &Fcntl::O_EXLOCK();
- };
-}
-
-# On some systems the O_TEMPORARY flag can be used to tell the OS
-# to automatically remove the file when it is closed. This is fine
-# in most cases but not if tempfile is called with UNLINK=>0 and
-# the filename is requested -- in the case where the filename is to
-# be passed to another routine. This happens on windows. We overcome
-# this by using a second open flags variable
-
-my $OPENTEMPFLAGS = $OPENFLAGS;
-unless ($^O eq 'MacOS') {
- for my $oflag (qw/ TEMPORARY /) {
- my ($bit, $func) = (0, "Fcntl::O_" . $oflag);
- local($@);
- no strict 'refs';
- $OPENTEMPFLAGS |= $bit if eval {
- # Make sure that redefined die handlers do not cause problems
- # e.g. CGI::Carp
- local $SIG{__DIE__} = sub {};
- local $SIG{__WARN__} = sub {};
- $bit = &$func();
- 1;
- };
- }
-}
-
-# Private hash tracking which files have been created by each process id via the OO interface
-my %FILES_CREATED_BY_OBJECT;
-
-# INTERNAL ROUTINES - not to be used outside of package
-
-# Generic routine for getting a temporary filename
-# modelled on OpenBSD _gettemp() in mktemp.c
-
-# The template must contain X's that are to be replaced
-# with the random values
-
-# Arguments:
-
-# TEMPLATE - string containing the XXXXX's that is converted
-# to a random filename and opened if required
-
-# Optionally, a hash can also be supplied containing specific options
-# "open" => if true open the temp file, else just return the name
-# default is 0
-# "mkdir"=> if true, we are creating a temp directory rather than tempfile
-# default is 0
-# "suffixlen" => number of characters at end of PATH to be ignored.
-# default is 0.
-# "unlink_on_close" => indicates that, if possible, the OS should remove
-# the file as soon as it is closed. Usually indicates
-# use of the O_TEMPORARY flag to sysopen.
-# Usually irrelevant on unix
-# "use_exlock" => Indicates that O_EXLOCK should be used. Default is true.
-
-# Optionally a reference to a scalar can be passed into the function
-# On error this will be used to store the reason for the error
-# "ErrStr" => \$errstr
-
-# "open" and "mkdir" can not both be true
-# "unlink_on_close" is not used when "mkdir" is true.
-
-# The default options are equivalent to mktemp().
-
-# Returns:
-# filehandle - open file handle (if called with doopen=1, else undef)
-# temp name - name of the temp file or directory
-
-# For example:
-# ($fh, $name) = _gettemp($template, "open" => 1);
-
-# for the current version, failures are associated with
-# stored in an error string and returned to give the reason whilst debugging
-# This routine is not called by any external function
-sub _gettemp {
-
- croak 'Usage: ($fh, $name) = _gettemp($template, OPTIONS);'
- unless scalar(@_) >= 1;
-
- # the internal error string - expect it to be overridden
- # Need this in case the caller decides not to supply us a value
- # need an anonymous scalar
- my $tempErrStr;
-
- # Default options
- my %options = (
- "open" => 0,
- "mkdir" => 0,
- "suffixlen" => 0,
- "unlink_on_close" => 0,
- "use_exlock" => 1,
- "ErrStr" => \$tempErrStr,
- );
-
- # Read the template
- my $template = shift;
- if (ref($template)) {
- # Use a warning here since we have not yet merged ErrStr
- carp "File::Temp::_gettemp: template must not be a reference";
- return ();
- }
-
- # Check that the number of entries on stack are even
- if (scalar(@_) % 2 != 0) {
- # Use a warning here since we have not yet merged ErrStr
- carp "File::Temp::_gettemp: Must have even number of options";
- return ();
- }
-
- # Read the options and merge with defaults
- %options = (%options, @_) if @_;
-
- # Make sure the error string is set to undef
- ${$options{ErrStr}} = undef;
-
- # Can not open the file and make a directory in a single call
- if ($options{"open"} && $options{"mkdir"}) {
- ${$options{ErrStr}} = "doopen and domkdir can not both be true\n";
- return ();
- }
-
- # Find the start of the end of the Xs (position of last X)
- # Substr starts from 0
- my $start = length($template) - 1 - $options{"suffixlen"};
-
- # Check that we have at least MINX x X (e.g. 'XXXX") at the end of the string
- # (taking suffixlen into account). Any fewer is insecure.
-
- # Do it using substr - no reason to use a pattern match since
- # we know where we are looking and what we are looking for
-
- if (substr($template, $start - MINX + 1, MINX) ne 'X' x MINX) {
- ${$options{ErrStr}} = "The template must end with at least ".
- MINX . " 'X' characters\n";
- return ();
- }
-
- # Replace all the X at the end of the substring with a
- # random character or just all the XX at the end of a full string.
- # Do it as an if, since the suffix adjusts which section to replace
- # and suffixlen=0 returns nothing if used in the substr directly
- # and generate a full path from the template
-
- my $path = _replace_XX($template, $options{"suffixlen"});
-
-
- # Split the path into constituent parts - eventually we need to check
- # whether the directory exists
- # We need to know whether we are making a temp directory
- # or a tempfile
-
- my ($volume, $directories, $file);
- my $parent; # parent directory
- if ($options{"mkdir"}) {
- # There is no filename at the end
- ($volume, $directories, $file) = File::Spec->splitpath( $path, 1);
-
- # The parent is then $directories without the last directory
- # Split the directory and put it back together again
- my @dirs = File::Spec->splitdir($directories);
-
- # If @dirs only has one entry (i.e. the directory template) that means
- # we are in the current directory
- if ($#dirs == 0) {
- $parent = File::Spec->curdir;
- } else {
-
- if ($^O eq 'VMS') { # need volume to avoid relative dir spec
- $parent = File::Spec->catdir($volume, @dirs[0..$#dirs-1]);
- $parent = 'sys$disk:[]' if $parent eq '';
- } else {
-
- # Put it back together without the last one
- $parent = File::Spec->catdir(@dirs[0..$#dirs-1]);
-
- # ...and attach the volume (no filename)
- $parent = File::Spec->catpath($volume, $parent, '');
- }
-
- }
-
- } else {
-
- # Get rid of the last filename (use File::Basename for this?)
- ($volume, $directories, $file) = File::Spec->splitpath( $path );
-
- # Join up without the file part
- $parent = File::Spec->catpath($volume,$directories,'');
-
- # If $parent is empty replace with curdir
- $parent = File::Spec->curdir
- unless $directories ne '';
-
- }
-
- # Check that the parent directories exist
- # Do this even for the case where we are simply returning a name
- # not a file -- no point returning a name that includes a directory
- # that does not exist or is not writable
-
- unless (-e $parent) {
- ${$options{ErrStr}} = "Parent directory ($parent) does not exist";
- return ();
- }
- unless (-d $parent) {
- ${$options{ErrStr}} = "Parent directory ($parent) is not a directory";
- return ();
- }
- unless (-w $parent) {
- ${$options{ErrStr}} = "Parent directory ($parent) is not writable\n";
- return ();
- }
-
-
- # Check the stickiness of the directory and chown giveaway if required
- # If the directory is world writable the sticky bit
- # must be set
-
- if (File::Temp->safe_level == MEDIUM) {
- my $safeerr;
- unless (_is_safe($parent,\$safeerr)) {
- ${$options{ErrStr}} = "Parent directory ($parent) is not safe ($safeerr)";
- return ();
- }
- } elsif (File::Temp->safe_level == HIGH) {
- my $safeerr;
- unless (_is_verysafe($parent, \$safeerr)) {
- ${$options{ErrStr}} = "Parent directory ($parent) is not safe ($safeerr)";
- return ();
- }
- }
-
-
- # Now try MAX_TRIES time to open the file
- for (my $i = 0; $i < MAX_TRIES; $i++) {
-
- # Try to open the file if requested
- if ($options{"open"}) {
- my $fh;
-
- # If we are running before perl5.6.0 we can not auto-vivify
- if ($] < 5.006) {
- $fh = &Symbol::gensym;
- }
-
- # Try to make sure this will be marked close-on-exec
- # XXX: Win32 doesn't respect this, nor the proper fcntl,
- # but may have O_NOINHERIT. This may or may not be in Fcntl.
- local $^F = 2;
-
- # Attempt to open the file
- my $open_success = undef;
- if ( $^O eq 'VMS' and $options{"unlink_on_close"} && !$KEEP_ALL) {
- # make it auto delete on close by setting FAB$V_DLT bit
- $fh = VMS::Stdio::vmssysopen($path, $OPENFLAGS, 0600, 'fop=dlt');
- $open_success = $fh;
- } else {
- my $flags = ( ($options{"unlink_on_close"} && !$KEEP_ALL) ?
- $OPENTEMPFLAGS :
- $OPENFLAGS );
- $flags |= $LOCKFLAG if (defined $LOCKFLAG && $options{use_exlock});
- $open_success = sysopen($fh, $path, $flags, 0600);
- }
- if ( $open_success ) {
-
- # in case of odd umask force rw
- chmod(0600, $path);
-
- # Opened successfully - return file handle and name
- return ($fh, $path);
-
- } else {
-
- # Error opening file - abort with error
- # if the reason was anything but EEXIST
- unless ($!{EEXIST}) {
- ${$options{ErrStr}} = "Could not create temp file $path: $!";
- return ();
- }
-
- # Loop round for another try
-
- }
- } elsif ($options{"mkdir"}) {
-
- # Open the temp directory
- if (mkdir( $path, 0700)) {
- # in case of odd umask
- chmod(0700, $path);
-
- return undef, $path;
- } else {
-
- # Abort with error if the reason for failure was anything
- # except EEXIST
- unless ($!{EEXIST}) {
- ${$options{ErrStr}} = "Could not create directory $path: $!";
- return ();
- }
-
- # Loop round for another try
-
- }
-
- } else {
-
- # Return true if the file can not be found
- # Directory has been checked previously
-
- return (undef, $path) unless -e $path;
-
- # Try again until MAX_TRIES
-
- }
-
- # Did not successfully open the tempfile/dir
- # so try again with a different set of random letters
- # No point in trying to increment unless we have only
- # 1 X say and the randomness could come up with the same
- # file MAX_TRIES in a row.
-
- # Store current attempt - in principal this implies that the
- # 3rd time around the open attempt that the first temp file
- # name could be generated again. Probably should store each
- # attempt and make sure that none are repeated
-
- my $original = $path;
- my $counter = 0; # Stop infinite loop
- my $MAX_GUESS = 50;
-
- do {
-
- # Generate new name from original template
- $path = _replace_XX($template, $options{"suffixlen"});
-
- $counter++;
-
- } until ($path ne $original || $counter > $MAX_GUESS);
-
- # Check for out of control looping
- if ($counter > $MAX_GUESS) {
- ${$options{ErrStr}} = "Tried to get a new temp name different to the previous value $MAX_GUESS times.\nSomething wrong with template?? ($template)";
- return ();
- }
-
- }
-
- # If we get here, we have run out of tries
- ${ $options{ErrStr} } = "Have exceeded the maximum number of attempts ("
- . MAX_TRIES . ") to open temp file/dir";
-
- return ();
-
-}
-
-# Internal routine to replace the XXXX... with random characters
-# This has to be done by _gettemp() every time it fails to
-# open a temp file/dir
-
-# Arguments: $template (the template with XXX),
-# $ignore (number of characters at end to ignore)
-
-# Returns: modified template
-
-sub _replace_XX {
-
- croak 'Usage: _replace_XX($template, $ignore)'
- unless scalar(@_) == 2;
-
- my ($path, $ignore) = @_;
-
- # Do it as an if, since the suffix adjusts which section to replace
- # and suffixlen=0 returns nothing if used in the substr directly
- # Alternatively, could simply set $ignore to length($path)-1
- # Don't want to always use substr when not required though.
- my $end = ( $] >= 5.006 ? "\\z" : "\\Z" );
-
- if ($ignore) {
- substr($path, 0, - $ignore) =~ s/X(?=X*$end)/$CHARS[ int( rand( @CHARS ) ) ]/ge;
- } else {
- $path =~ s/X(?=X*$end)/$CHARS[ int( rand( @CHARS ) ) ]/ge;
- }
- return $path;
-}
-
-# Internal routine to force a temp file to be writable after
-# it is created so that we can unlink it. Windows seems to occassionally
-# force a file to be readonly when written to certain temp locations
-sub _force_writable {
- my $file = shift;
- chmod 0600, $file;
-}
-
-
-# internal routine to check to see if the directory is safe
-# First checks to see if the directory is not owned by the
-# current user or root. Then checks to see if anyone else
-# can write to the directory and if so, checks to see if
-# it has the sticky bit set
-
-# Will not work on systems that do not support sticky bit
-
-#Args: directory path to check
-# Optionally: reference to scalar to contain error message
-# Returns true if the path is safe and false otherwise.
-# Returns undef if can not even run stat() on the path
-
-# This routine based on version written by Tom Christiansen
-
-# Presumably, by the time we actually attempt to create the
-# file or directory in this directory, it may not be safe
-# anymore... Have to run _is_safe directly after the open.
-
-sub _is_safe {
-
- my $path = shift;
- my $err_ref = shift;
-
- # Stat path
- my @info = stat($path);
- unless (scalar(@info)) {
- $$err_ref = "stat(path) returned no values";
- return 0;
- };
- return 1 if $^O eq 'VMS'; # owner delete control at file level
-
- # Check to see whether owner is neither superuser (or a system uid) nor me
- # Use the effective uid from the $> variable
- # UID is in [4]
- if ($info[4] > File::Temp->top_system_uid() && $info[4] != $>) {
-
- Carp::cluck(sprintf "uid=$info[4] topuid=%s euid=$> path='$path'",
- File::Temp->top_system_uid());
-
- $$err_ref = "Directory owned neither by root nor the current user"
- if ref($err_ref);
- return 0;
- }
-
- # check whether group or other can write file
- # use 066 to detect either reading or writing
- # use 022 to check writability
- # Do it with S_IWOTH and S_IWGRP for portability (maybe)
- # mode is in info[2]
- if (($info[2] & &Fcntl::S_IWGRP) || # Is group writable?
- ($info[2] & &Fcntl::S_IWOTH) ) { # Is world writable?
- # Must be a directory
- unless (-d $path) {
- $$err_ref = "Path ($path) is not a directory"
- if ref($err_ref);
- return 0;
- }
- # Must have sticky bit set
- unless (-k $path) {
- $$err_ref = "Sticky bit not set on $path when dir is group|world writable"
- if ref($err_ref);
- return 0;
- }
- }
-
- return 1;
-}
-
-# Internal routine to check whether a directory is safe
-# for temp files. Safer than _is_safe since it checks for
-# the possibility of chown giveaway and if that is a possibility
-# checks each directory in the path to see if it is safe (with _is_safe)
-
-# If _PC_CHOWN_RESTRICTED is not set, does the full test of each
-# directory anyway.
-
-# Takes optional second arg as scalar ref to error reason
-
-sub _is_verysafe {
-
- # Need POSIX - but only want to bother if really necessary due to overhead
- require POSIX;
-
- my $path = shift;
- print "_is_verysafe testing $path\n" if $DEBUG;
- return 1 if $^O eq 'VMS'; # owner delete control at file level
-
- my $err_ref = shift;
-
- # Should Get the value of _PC_CHOWN_RESTRICTED if it is defined
- # and If it is not there do the extensive test
- local($@);
- my $chown_restricted;
- $chown_restricted = &POSIX::_PC_CHOWN_RESTRICTED()
- if eval { &POSIX::_PC_CHOWN_RESTRICTED(); 1};
-
- # If chown_resticted is set to some value we should test it
- if (defined $chown_restricted) {
-
- # Return if the current directory is safe
- return _is_safe($path,$err_ref) if POSIX::sysconf( $chown_restricted );
-
- }
-
- # To reach this point either, the _PC_CHOWN_RESTRICTED symbol
- # was not avialable or the symbol was there but chown giveaway
- # is allowed. Either way, we now have to test the entire tree for
- # safety.
-
- # Convert path to an absolute directory if required
- unless (File::Spec->file_name_is_absolute($path)) {
- $path = File::Spec->rel2abs($path);
- }
-
- # Split directory into components - assume no file
- my ($volume, $directories, undef) = File::Spec->splitpath( $path, 1);
-
- # Slightly less efficient than having a function in File::Spec
- # to chop off the end of a directory or even a function that
- # can handle ../ in a directory tree
- # Sometimes splitdir() returns a blank at the end
- # so we will probably check the bottom directory twice in some cases
- my @dirs = File::Spec->splitdir($directories);
-
- # Concatenate one less directory each time around
- foreach my $pos (0.. $#dirs) {
- # Get a directory name
- my $dir = File::Spec->catpath($volume,
- File::Spec->catdir(@dirs[0.. $#dirs - $pos]),
- ''
- );
-
- print "TESTING DIR $dir\n" if $DEBUG;
-
- # Check the directory
- return 0 unless _is_safe($dir,$err_ref);
-
- }
-
- return 1;
-}
-
-
-
-# internal routine to determine whether unlink works on this
-# platform for files that are currently open.
-# Returns true if we can, false otherwise.
-
-# Currently WinNT, OS/2 and VMS can not unlink an opened file
-# On VMS this is because the O_EXCL flag is used to open the
-# temporary file. Currently I do not know enough about the issues
-# on VMS to decide whether O_EXCL is a requirement.
-
-sub _can_unlink_opened_file {
-
- if ($^O eq 'MSWin32' || $^O eq 'os2' || $^O eq 'VMS' || $^O eq 'dos' || $^O eq 'MacOS') {
- return 0;
- } else {
- return 1;
- }
-
-}
-
-# internal routine to decide which security levels are allowed
-# see safe_level() for more information on this
-
-# Controls whether the supplied security level is allowed
-
-# $cando = _can_do_level( $level )
-
-sub _can_do_level {
-
- # Get security level
- my $level = shift;
-
- # Always have to be able to do STANDARD
- return 1 if $level == STANDARD;
-
- # Currently, the systems that can do HIGH or MEDIUM are identical
- if ( $^O eq 'MSWin32' || $^O eq 'os2' || $^O eq 'cygwin' || $^O eq 'dos' || $^O eq 'MacOS' || $^O eq 'mpeix') {
- return 0;
- } else {
- return 1;
- }
-
-}
-
-# This routine sets up a deferred unlinking of a specified
-# filename and filehandle. It is used in the following cases:
-# - Called by unlink0 if an opened file can not be unlinked
-# - Called by tempfile() if files are to be removed on shutdown
-# - Called by tempdir() if directories are to be removed on shutdown
-
-# Arguments:
-# _deferred_unlink( $fh, $fname, $isdir );
-#
-# - filehandle (so that it can be expclicitly closed if open
-# - filename (the thing we want to remove)
-# - isdir (flag to indicate that we are being given a directory)
-# [and hence no filehandle]
-
-# Status is not referred to since all the magic is done with an END block
-
-{
- # Will set up two lexical variables to contain all the files to be
- # removed. One array for files, another for directories They will
- # only exist in this block.
-
- # This means we only have to set up a single END block to remove
- # all files.
-
- # in order to prevent child processes inadvertently deleting the parent
- # temp files we use a hash to store the temp files and directories
- # created by a particular process id.
-
- # %files_to_unlink contains values that are references to an array of
- # array references containing the filehandle and filename associated with
- # the temp file.
- my (%files_to_unlink, %dirs_to_unlink);
-
- # Set up an end block to use these arrays
- END {
- cleanup();
- }
-
- # Cleanup function. Always triggered on END but can be invoked
- # manually.
- sub cleanup {
- if (!$KEEP_ALL) {
- # Files
- my @files = (exists $files_to_unlink{$$} ?
- @{ $files_to_unlink{$$} } : () );
- foreach my $file (@files) {
- # close the filehandle without checking its state
- # in order to make real sure that this is closed
- # if its already closed then I dont care about the answer
- # probably a better way to do this
- close($file->[0]); # file handle is [0]
-
- if (-f $file->[1]) { # file name is [1]
- _force_writable( $file->[1] ); # for windows
- unlink $file->[1] or warn "Error removing ".$file->[1];
- }
- }
- # Dirs
- my @dirs = (exists $dirs_to_unlink{$$} ?
- @{ $dirs_to_unlink{$$} } : () );
- foreach my $dir (@dirs) {
- if (-d $dir) {
- rmtree($dir, $DEBUG, 0);
- }
- }
-
- # clear the arrays
- @{ $files_to_unlink{$$} } = ()
- if exists $files_to_unlink{$$};
- @{ $dirs_to_unlink{$$} } = ()
- if exists $dirs_to_unlink{$$};
- }
- }
-
-
- # This is the sub called to register a file for deferred unlinking
- # This could simply store the input parameters and defer everything
- # until the END block. For now we do a bit of checking at this
- # point in order to make sure that (1) we have a file/dir to delete
- # and (2) we have been called with the correct arguments.
- sub _deferred_unlink {
-
- croak 'Usage: _deferred_unlink($fh, $fname, $isdir)'
- unless scalar(@_) == 3;
-
- my ($fh, $fname, $isdir) = @_;
-
- warn "Setting up deferred removal of $fname\n"
- if $DEBUG;
-
- # If we have a directory, check that it is a directory
- if ($isdir) {
-
- if (-d $fname) {
-
- # Directory exists so store it
- # first on VMS turn []foo into [.foo] for rmtree
- $fname = VMS::Filespec::vmspath($fname) if $^O eq 'VMS';
- $dirs_to_unlink{$$} = []
- unless exists $dirs_to_unlink{$$};
- push (@{ $dirs_to_unlink{$$} }, $fname);
-
- } else {
- carp "Request to remove directory $fname could not be completed since it does not exist!\n" if $^W;
- }
-
- } else {
-
- if (-f $fname) {
-
- # file exists so store handle and name for later removal
- $files_to_unlink{$$} = []
- unless exists $files_to_unlink{$$};
- push(@{ $files_to_unlink{$$} }, [$fh, $fname]);
-
- } else {
- carp "Request to remove file $fname could not be completed since it is not there!\n" if $^W;
- }
-
- }
-
- }
-
-
-}
-
-=head1 OBJECT-ORIENTED INTERFACE
-
-This is the primary interface for interacting with
-C<File::Temp>. Using the OO interface a temporary file can be created
-when the object is constructed and the file can be removed when the
-object is no longer required.
-
-Note that there is no method to obtain the filehandle from the
-C<File::Temp> object. The object itself acts as a filehandle. Also,
-the object is configured such that it stringifies to the name of the
-temporary file, and can be compared to a filename directly. The object
-isa C<IO::Handle> and isa C<IO::Seekable> so all those methods are
-available.
-
-=over 4
-
-=item B<new>
-
-Create a temporary file object.
-
- my $tmp = File::Temp->new();
-
-by default the object is constructed as if C<tempfile>
-was called without options, but with the additional behaviour
-that the temporary file is removed by the object destructor
-if UNLINK is set to true (the default).
-
-Supported arguments are the same as for C<tempfile>: UNLINK
-(defaulting to true), DIR, EXLOCK and SUFFIX. Additionally, the filename
-template is specified using the TEMPLATE option. The OPEN option
-is not supported (the file is always opened).
-
- $tmp = File::Temp->new( TEMPLATE => 'tempXXXXX',
- DIR => 'mydir',
- SUFFIX => '.dat');
-
-Arguments are case insensitive.
-
-Can call croak() if an error occurs.
-
-=cut
-
-sub new {
- my $proto = shift;
- my $class = ref($proto) || $proto;
-
- # read arguments and convert keys to upper case
- my %args = @_;
- %args = map { uc($_), $args{$_} } keys %args;
-
- # see if they are unlinking (defaulting to yes)
- my $unlink = (exists $args{UNLINK} ? $args{UNLINK} : 1 );
- delete $args{UNLINK};
-
- # template (store it in an error so that it will
- # disappear from the arg list of tempfile
- my @template = ( exists $args{TEMPLATE} ? $args{TEMPLATE} : () );
- delete $args{TEMPLATE};
-
- # Protect OPEN
- delete $args{OPEN};
-
- # Open the file and retain file handle and file name
- my ($fh, $path) = tempfile( @template, %args );
-
- print "Tmp: $fh - $path\n" if $DEBUG;
-
- # Store the filename in the scalar slot
- ${*$fh} = $path;
-
- # Cache the filename by pid so that the destructor can decide whether to remove it
- $FILES_CREATED_BY_OBJECT{$$}{$path} = 1;
-
- # Store unlink information in hash slot (plus other constructor info)
- %{*$fh} = %args;
-
- # create the object
- bless $fh, $class;
-
- # final method-based configuration
- $fh->unlink_on_destroy( $unlink );
-
- return $fh;
-}
-
-=item B<newdir>
-
-Create a temporary directory using an object oriented interface.
-
- $dir = File::Temp->newdir();
-
-By default the directory is deleted when the object goes out of scope.
-
-Supports the same options as the C<tempdir> function. Note that directories
-created with this method default to CLEANUP => 1.
-
- $dir = File::Temp->newdir( $template, %options );
-
-=cut
-
-sub newdir {
- my $self = shift;
-
- # need to handle args as in tempdir because we have to force CLEANUP
- # default without passing CLEANUP to tempdir
- my $template = (scalar(@_) % 2 == 1 ? shift(@_) : undef );
- my %options = @_;
- my $cleanup = (exists $options{CLEANUP} ? $options{CLEANUP} : 1 );
-
- delete $options{CLEANUP};
-
- my $tempdir;
- if (defined $template) {
- $tempdir = tempdir( $template, %options );
- } else {
- $tempdir = tempdir( %options );
- }
- return bless { DIRNAME => $tempdir,
- CLEANUP => $cleanup,
- LAUNCHPID => $$,
- }, "File::Temp::Dir";
-}
-
-=item B<filename>
-
-Return the name of the temporary file associated with this object
-(if the object was created using the "new" constructor).
-
- $filename = $tmp->filename;
-
-This method is called automatically when the object is used as
-a string.
-
-=cut
-
-sub filename {
- my $self = shift;
- return ${*$self};
-}
-
-sub STRINGIFY {
- my $self = shift;
- return $self->filename;
-}
-
-=item B<dirname>
-
-Return the name of the temporary directory associated with this
-object (if the object was created using the "newdir" constructor).
-
- $dirname = $tmpdir->dirname;
-
-This method is called automatically when the object is used in string context.
-
-=item B<unlink_on_destroy>
-
-Control whether the file is unlinked when the object goes out of scope.
-The file is removed if this value is true and $KEEP_ALL is not.
-
- $fh->unlink_on_destroy( 1 );
-
-Default is for the file to be removed.
-
-=cut
-
-sub unlink_on_destroy {
- my $self = shift;
- if (@_) {
- ${*$self}{UNLINK} = shift;
- }
- return ${*$self}{UNLINK};
-}
-
-=item B<DESTROY>
-
-When the object goes out of scope, the destructor is called. This
-destructor will attempt to unlink the file (using C<unlink1>)
-if the constructor was called with UNLINK set to 1 (the default state
-if UNLINK is not specified).
-
-No error is given if the unlink fails.
-
-If the object has been passed to a child process during a fork, the
-file will be deleted when the object goes out of scope in the parent.
-
-For a temporary directory object the directory will be removed
-unless the CLEANUP argument was used in the constructor (and set to
-false) or C<unlink_on_destroy> was modified after creation.
-
-If the global variable $KEEP_ALL is true, the file or directory
-will not be removed.
-
-=cut
-
-sub DESTROY {
- my $self = shift;
- if (${*$self}{UNLINK} && !$KEEP_ALL) {
- print "# ---------> Unlinking $self\n" if $DEBUG;
-
- # only delete if this process created it
- return unless exists $FILES_CREATED_BY_OBJECT{$$}{$self->filename};
-
- # The unlink1 may fail if the file has been closed
- # by the caller. This leaves us with the decision
- # of whether to refuse to remove the file or simply
- # do an unlink without test. Seems to be silly
- # to do this when we are trying to be careful
- # about security
- _force_writable( $self->filename ); # for windows
- unlink1( $self, $self->filename )
- or unlink($self->filename);
- }
-}
-
-=back
-
-=head1 FUNCTIONS
-
-This section describes the recommended interface for generating
-temporary files and directories.
-
-=over 4
-
-=item B<tempfile>
-
-This is the basic function to generate temporary files.
-The behaviour of the file can be changed using various options:
-
- $fh = tempfile();
- ($fh, $filename) = tempfile();
-
-Create a temporary file in the directory specified for temporary
-files, as specified by the tmpdir() function in L<File::Spec>.
-
- ($fh, $filename) = tempfile($template);
-
-Create a temporary file in the current directory using the supplied
-template. Trailing `X' characters are replaced with random letters to
-generate the filename. At least four `X' characters must be present
-at the end of the template.
-
- ($fh, $filename) = tempfile($template, SUFFIX => $suffix)
-
-Same as previously, except that a suffix is added to the template
-after the `X' translation. Useful for ensuring that a temporary
-filename has a particular extension when needed by other applications.
-But see the WARNING at the end.
-
- ($fh, $filename) = tempfile($template, DIR => $dir);
-
-Translates the template as before except that a directory name
-is specified.
-
- ($fh, $filename) = tempfile($template, TMPDIR => 1);
-
-Equivalent to specifying a DIR of "File::Spec->tmpdir", writing the file
-into the same temporary directory as would be used if no template was
-specified at all.
-
- ($fh, $filename) = tempfile($template, UNLINK => 1);
-
-Return the filename and filehandle as before except that the file is
-automatically removed when the program exits (dependent on
-$KEEP_ALL). Default is for the file to be removed if a file handle is
-requested and to be kept if the filename is requested. In a scalar
-context (where no filename is returned) the file is always deleted
-either (depending on the operating system) on exit or when it is
-closed (unless $KEEP_ALL is true when the temp file is created).
-
-Use the object-oriented interface if fine-grained control of when
-a file is removed is required.
-
-If the template is not specified, a template is always
-automatically generated. This temporary file is placed in tmpdir()
-(L<File::Spec>) unless a directory is specified explicitly with the
-DIR option.
-
- $fh = tempfile( DIR => $dir );
-
-If called in scalar context, only the filehandle is returned and the
-file will automatically be deleted when closed on operating systems
-that support this (see the description of tmpfile() elsewhere in this
-document). This is the preferred mode of operation, as if you only
-have a filehandle, you can never create a race condition by fumbling
-with the filename. On systems that can not unlink an open file or can
-not mark a file as temporary when it is opened (for example, Windows
-NT uses the C<O_TEMPORARY> flag) the file is marked for deletion when
-the program ends (equivalent to setting UNLINK to 1). The C<UNLINK>
-flag is ignored if present.
-
- (undef, $filename) = tempfile($template, OPEN => 0);
-
-This will return the filename based on the template but
-will not open this file. Cannot be used in conjunction with
-UNLINK set to true. Default is to always open the file
-to protect from possible race conditions. A warning is issued
-if warnings are turned on. Consider using the tmpnam()
-and mktemp() functions described elsewhere in this document
-if opening the file is not required.
-
-If the operating system supports it (for example BSD derived systems), the
-filehandle will be opened with O_EXLOCK (open with exclusive file lock).
-This can sometimes cause problems if the intention is to pass the filename
-to another system that expects to take an exclusive lock itself (such as
-DBD::SQLite) whilst ensuring that the tempfile is not reused. In this
-situation the "EXLOCK" option can be passed to tempfile. By default EXLOCK
-will be true (this retains compatibility with earlier releases).
-
- ($fh, $filename) = tempfile($template, EXLOCK => 0);
-
-Options can be combined as required.
-
-Will croak() if there is an error.
-
-=cut
-
-sub tempfile {
-
- # Can not check for argument count since we can have any
- # number of args
-
- # Default options
- my %options = (
- "DIR" => undef, # Directory prefix
- "SUFFIX" => '', # Template suffix
- "UNLINK" => 0, # Do not unlink file on exit
- "OPEN" => 1, # Open file
- "TMPDIR" => 0, # Place tempfile in tempdir if template specified
- "EXLOCK" => 1, # Open file with O_EXLOCK
- );
-
- # Check to see whether we have an odd or even number of arguments
- my $template = (scalar(@_) % 2 == 1 ? shift(@_) : undef);
-
- # Read the options and merge with defaults
- %options = (%options, @_) if @_;
-
- # First decision is whether or not to open the file
- if (! $options{"OPEN"}) {
-
- warn "tempfile(): temporary filename requested but not opened.\nPossibly unsafe, consider using tempfile() with OPEN set to true\n"
- if $^W;
-
- }
-
- if ($options{"DIR"} and $^O eq 'VMS') {
-
- # on VMS turn []foo into [.foo] for concatenation
- $options{"DIR"} = VMS::Filespec::vmspath($options{"DIR"});
- }
-
- # Construct the template
-
- # Have a choice of trying to work around the mkstemp/mktemp/tmpnam etc
- # functions or simply constructing a template and using _gettemp()
- # explicitly. Go for the latter
-
- # First generate a template if not defined and prefix the directory
- # If no template must prefix the temp directory
- if (defined $template) {
- # End up with current directory if neither DIR not TMPDIR are set
- if ($options{"DIR"}) {
-
- $template = File::Spec->catfile($options{"DIR"}, $template);
-
- } elsif ($options{TMPDIR}) {
-
- $template = File::Spec->catfile(File::Spec->tmpdir, $template );
-
- }
-
- } else {
-
- if ($options{"DIR"}) {
-
- $template = File::Spec->catfile($options{"DIR"}, TEMPXXX);
-
- } else {
-
- $template = File::Spec->catfile(File::Spec->tmpdir, TEMPXXX);
-
- }
-
- }
-
- # Now add a suffix
- $template .= $options{"SUFFIX"};
-
- # Determine whether we should tell _gettemp to unlink the file
- # On unix this is irrelevant and can be worked out after the file is
- # opened (simply by unlinking the open filehandle). On Windows or VMS
- # we have to indicate temporary-ness when we open the file. In general
- # we only want a true temporary file if we are returning just the
- # filehandle - if the user wants the filename they probably do not
- # want the file to disappear as soon as they close it (which may be
- # important if they want a child process to use the file)
- # For this reason, tie unlink_on_close to the return context regardless
- # of OS.
- my $unlink_on_close = ( wantarray ? 0 : 1);
-
- # Create the file
- my ($fh, $path, $errstr);
- croak "Error in tempfile() using $template: $errstr"
- unless (($fh, $path) = _gettemp($template,
- "open" => $options{'OPEN'},
- "mkdir"=> 0 ,
- "unlink_on_close" => $unlink_on_close,
- "suffixlen" => length($options{'SUFFIX'}),
- "ErrStr" => \$errstr,
- "use_exlock" => $options{EXLOCK},
- ) );
-
- # Set up an exit handler that can do whatever is right for the
- # system. This removes files at exit when requested explicitly or when
- # system is asked to unlink_on_close but is unable to do so because
- # of OS limitations.
- # The latter should be achieved by using a tied filehandle.
- # Do not check return status since this is all done with END blocks.
- _deferred_unlink($fh, $path, 0) if $options{"UNLINK"};
-
- # Return
- if (wantarray()) {
-
- if ($options{'OPEN'}) {
- return ($fh, $path);
- } else {
- return (undef, $path);
- }
-
- } else {
-
- # Unlink the file. It is up to unlink0 to decide what to do with
- # this (whether to unlink now or to defer until later)
- unlink0($fh, $path) or croak "Error unlinking file $path using unlink0";
-
- # Return just the filehandle.
- return $fh;
- }
-
-
-}
-
-=item B<tempdir>
-
-This is the recommended interface for creation of temporary
-directories. By default the directory will not be removed on exit
-(that is, it won't be temporary; this behaviour can not be changed
-because of issues with backwards compatibility). To enable removal
-either use the CLEANUP option which will trigger removal on program
-exit, or consider using the "newdir" method in the object interface which
-will allow the directory to be cleaned up when the object goes out of
-scope.
-
-The behaviour of the function depends on the arguments:
-
- $tempdir = tempdir();
-
-Create a directory in tmpdir() (see L<File::Spec|File::Spec>).
-
- $tempdir = tempdir( $template );
-
-Create a directory from the supplied template. This template is
-similar to that described for tempfile(). `X' characters at the end
-of the template are replaced with random letters to construct the
-directory name. At least four `X' characters must be in the template.
-
- $tempdir = tempdir ( DIR => $dir );
-
-Specifies the directory to use for the temporary directory.
-The temporary directory name is derived from an internal template.
-
- $tempdir = tempdir ( $template, DIR => $dir );
-
-Prepend the supplied directory name to the template. The template
-should not include parent directory specifications itself. Any parent
-directory specifications are removed from the template before
-prepending the supplied directory.
-
- $tempdir = tempdir ( $template, TMPDIR => 1 );
-
-Using the supplied template, create the temporary directory in
-a standard location for temporary files. Equivalent to doing
-
- $tempdir = tempdir ( $template, DIR => File::Spec->tmpdir);
-
-but shorter. Parent directory specifications are stripped from the
-template itself. The C<TMPDIR> option is ignored if C<DIR> is set
-explicitly. Additionally, C<TMPDIR> is implied if neither a template
-nor a directory are supplied.
-
- $tempdir = tempdir( $template, CLEANUP => 1);
-
-Create a temporary directory using the supplied template, but
-attempt to remove it (and all files inside it) when the program
-exits. Note that an attempt will be made to remove all files from
-the directory even if they were not created by this module (otherwise
-why ask to clean it up?). The directory removal is made with
-the rmtree() function from the L<File::Path|File::Path> module.
-Of course, if the template is not specified, the temporary directory
-will be created in tmpdir() and will also be removed at program exit.
-
-Will croak() if there is an error.
-
-=cut
-
-# '
-
-sub tempdir {
-
- # Can not check for argument count since we can have any
- # number of args
-
- # Default options
- my %options = (
- "CLEANUP" => 0, # Remove directory on exit
- "DIR" => '', # Root directory
- "TMPDIR" => 0, # Use tempdir with template
- );
-
- # Check to see whether we have an odd or even number of arguments
- my $template = (scalar(@_) % 2 == 1 ? shift(@_) : undef );
-
- # Read the options and merge with defaults
- %options = (%options, @_) if @_;
-
- # Modify or generate the template
-
- # Deal with the DIR and TMPDIR options
- if (defined $template) {
-
- # Need to strip directory path if using DIR or TMPDIR
- if ($options{'TMPDIR'} || $options{'DIR'}) {
-
- # Strip parent directory from the filename
- #
- # There is no filename at the end
- $template = VMS::Filespec::vmspath($template) if $^O eq 'VMS';
- my ($volume, $directories, undef) = File::Spec->splitpath( $template, 1);
-
- # Last directory is then our template
- $template = (File::Spec->splitdir($directories))[-1];
-
- # Prepend the supplied directory or temp dir
- if ($options{"DIR"}) {
-
- $template = File::Spec->catdir($options{"DIR"}, $template);
-
- } elsif ($options{TMPDIR}) {
-
- # Prepend tmpdir
- $template = File::Spec->catdir(File::Spec->tmpdir, $template);
-
- }
-
- }
-
- } else {
-
- if ($options{"DIR"}) {
-
- $template = File::Spec->catdir($options{"DIR"}, TEMPXXX);
-
- } else {
-
- $template = File::Spec->catdir(File::Spec->tmpdir, TEMPXXX);
-
- }
-
- }
-
- # Create the directory
- my $tempdir;
- my $suffixlen = 0;
- if ($^O eq 'VMS') { # dir names can end in delimiters
- $template =~ m/([\.\]:>]+)$/;
- $suffixlen = length($1);
- }
- if ( ($^O eq 'MacOS') && (substr($template, -1) eq ':') ) {
- # dir name has a trailing ':'
- ++$suffixlen;
- }
-
- my $errstr;
- croak "Error in tempdir() using $template: $errstr"
- unless ((undef, $tempdir) = _gettemp($template,
- "open" => 0,
- "mkdir"=> 1 ,
- "suffixlen" => $suffixlen,
- "ErrStr" => \$errstr,
- ) );
-
- # Install exit handler; must be dynamic to get lexical
- if ( $options{'CLEANUP'} && -d $tempdir) {
- _deferred_unlink(undef, $tempdir, 1);
- }
-
- # Return the dir name
- return $tempdir;
-
-}
-
-=back
-
-=head1 MKTEMP FUNCTIONS
-
-The following functions are Perl implementations of the
-mktemp() family of temp file generation system calls.
-
-=over 4
-
-=item B<mkstemp>
-
-Given a template, returns a filehandle to the temporary file and the name
-of the file.
-
- ($fh, $name) = mkstemp( $template );
-
-In scalar context, just the filehandle is returned.
-
-The template may be any filename with some number of X's appended
-to it, for example F</tmp/temp.XXXX>. The trailing X's are replaced
-with unique alphanumeric combinations.
-
-Will croak() if there is an error.
-
-=cut
-
-
-
-sub mkstemp {
-
- croak "Usage: mkstemp(template)"
- if scalar(@_) != 1;
-
- my $template = shift;
-
- my ($fh, $path, $errstr);
- croak "Error in mkstemp using $template: $errstr"
- unless (($fh, $path) = _gettemp($template,
- "open" => 1,
- "mkdir"=> 0 ,
- "suffixlen" => 0,
- "ErrStr" => \$errstr,
- ) );
-
- if (wantarray()) {
- return ($fh, $path);
- } else {
- return $fh;
- }
-
-}
-
-
-=item B<mkstemps>
-
-Similar to mkstemp(), except that an extra argument can be supplied
-with a suffix to be appended to the template.
-
- ($fh, $name) = mkstemps( $template, $suffix );
-
-For example a template of C<testXXXXXX> and suffix of C<.dat>
-would generate a file similar to F<testhGji_w.dat>.
-
-Returns just the filehandle alone when called in scalar context.
-
-Will croak() if there is an error.
-
-=cut
-
-sub mkstemps {
-
- croak "Usage: mkstemps(template, suffix)"
- if scalar(@_) != 2;
-
-
- my $template = shift;
- my $suffix = shift;
-
- $template .= $suffix;
-
- my ($fh, $path, $errstr);
- croak "Error in mkstemps using $template: $errstr"
- unless (($fh, $path) = _gettemp($template,
- "open" => 1,
- "mkdir"=> 0 ,
- "suffixlen" => length($suffix),
- "ErrStr" => \$errstr,
- ) );
-
- if (wantarray()) {
- return ($fh, $path);
- } else {
- return $fh;
- }
-
-}
-
-=item B<mkdtemp>
-
-Create a directory from a template. The template must end in
-X's that are replaced by the routine.
-
- $tmpdir_name = mkdtemp($template);
-
-Returns the name of the temporary directory created.
-
-Directory must be removed by the caller.
-
-Will croak() if there is an error.
-
-=cut
-
-#' # for emacs
-
-sub mkdtemp {
-
- croak "Usage: mkdtemp(template)"
- if scalar(@_) != 1;
-
- my $template = shift;
- my $suffixlen = 0;
- if ($^O eq 'VMS') { # dir names can end in delimiters
- $template =~ m/([\.\]:>]+)$/;
- $suffixlen = length($1);
- }
- if ( ($^O eq 'MacOS') && (substr($template, -1) eq ':') ) {
- # dir name has a trailing ':'
- ++$suffixlen;
- }
- my ($junk, $tmpdir, $errstr);
- croak "Error creating temp directory from template $template\: $errstr"
- unless (($junk, $tmpdir) = _gettemp($template,
- "open" => 0,
- "mkdir"=> 1 ,
- "suffixlen" => $suffixlen,
- "ErrStr" => \$errstr,
- ) );
-
- return $tmpdir;
-
-}
-
-=item B<mktemp>
-
-Returns a valid temporary filename but does not guarantee
-that the file will not be opened by someone else.
-
- $unopened_file = mktemp($template);
-
-Template is the same as that required by mkstemp().
-
-Will croak() if there is an error.
-
-=cut
-
-sub mktemp {
-
- croak "Usage: mktemp(template)"
- if scalar(@_) != 1;
-
- my $template = shift;
-
- my ($tmpname, $junk, $errstr);
- croak "Error getting name to temp file from template $template: $errstr"
- unless (($junk, $tmpname) = _gettemp($template,
- "open" => 0,
- "mkdir"=> 0 ,
- "suffixlen" => 0,
- "ErrStr" => \$errstr,
- ) );
-
- return $tmpname;
-}
-
-=back
-
-=head1 POSIX FUNCTIONS
-
-This section describes the re-implementation of the tmpnam()
-and tmpfile() functions described in L<POSIX>
-using the mkstemp() from this module.
-
-Unlike the L<POSIX|POSIX> implementations, the directory used
-for the temporary file is not specified in a system include
-file (C<P_tmpdir>) but simply depends on the choice of tmpdir()
-returned by L<File::Spec|File::Spec>. On some implementations this
-location can be set using the C<TMPDIR> environment variable, which
-may not be secure.
-If this is a problem, simply use mkstemp() and specify a template.
-
-=over 4
-
-=item B<tmpnam>
-
-When called in scalar context, returns the full name (including path)
-of a temporary file (uses mktemp()). The only check is that the file does
-not already exist, but there is no guarantee that that condition will
-continue to apply.
-
- $file = tmpnam();
-
-When called in list context, a filehandle to the open file and
-a filename are returned. This is achieved by calling mkstemp()
-after constructing a suitable template.
-
- ($fh, $file) = tmpnam();
-
-If possible, this form should be used to prevent possible
-race conditions.
-
-See L<File::Spec/tmpdir> for information on the choice of temporary
-directory for a particular operating system.
-
-Will croak() if there is an error.
-
-=cut
-
-sub tmpnam {
-
- # Retrieve the temporary directory name
- my $tmpdir = File::Spec->tmpdir;
-
- croak "Error temporary directory is not writable"
- if $tmpdir eq '';
-
- # Use a ten character template and append to tmpdir
- my $template = File::Spec->catfile($tmpdir, TEMPXXX);
-
- if (wantarray() ) {
- return mkstemp($template);
- } else {
- return mktemp($template);
- }
-
-}
-
-=item B<tmpfile>
-
-Returns the filehandle of a temporary file.
-
- $fh = tmpfile();
-
-The file is removed when the filehandle is closed or when the program
-exits. No access to the filename is provided.
-
-If the temporary file can not be created undef is returned.
-Currently this command will probably not work when the temporary
-directory is on an NFS file system.
-
-Will croak() if there is an error.
-
-=cut
-
-sub tmpfile {
-
- # Simply call tmpnam() in a list context
- my ($fh, $file) = tmpnam();
-
- # Make sure file is removed when filehandle is closed
- # This will fail on NFS
- unlink0($fh, $file)
- or return undef;
-
- return $fh;
-
-}
-
-=back
-
-=head1 ADDITIONAL FUNCTIONS
-
-These functions are provided for backwards compatibility
-with common tempfile generation C library functions.
-
-They are not exported and must be addressed using the full package
-name.
-
-=over 4
-
-=item B<tempnam>
-
-Return the name of a temporary file in the specified directory
-using a prefix. The file is guaranteed not to exist at the time
-the function was called, but such guarantees are good for one
-clock tick only. Always use the proper form of C<sysopen>
-with C<O_CREAT | O_EXCL> if you must open such a filename.
-
- $filename = File::Temp::tempnam( $dir, $prefix );
-
-Equivalent to running mktemp() with $dir/$prefixXXXXXXXX
-(using unix file convention as an example)
-
-Because this function uses mktemp(), it can suffer from race conditions.
-
-Will croak() if there is an error.
-
-=cut
-
-sub tempnam {
-
- croak 'Usage tempnam($dir, $prefix)' unless scalar(@_) == 2;
-
- my ($dir, $prefix) = @_;
-
- # Add a string to the prefix
- $prefix .= 'XXXXXXXX';
-
- # Concatenate the directory to the file
- my $template = File::Spec->catfile($dir, $prefix);
-
- return mktemp($template);
-
-}
-
-=back
-
-=head1 UTILITY FUNCTIONS
-
-Useful functions for dealing with the filehandle and filename.
-
-=over 4
-
-=item B<unlink0>
-
-Given an open filehandle and the associated filename, make a safe
-unlink. This is achieved by first checking that the filename and
-filehandle initially point to the same file and that the number of
-links to the file is 1 (all fields returned by stat() are compared).
-Then the filename is unlinked and the filehandle checked once again to
-verify that the number of links on that file is now 0. This is the
-closest you can come to making sure that the filename unlinked was the
-same as the file whose descriptor you hold.
-
- unlink0($fh, $path)
- or die "Error unlinking file $path safely";
-
-Returns false on error but croaks() if there is a security
-anomaly. The filehandle is not closed since on some occasions this is
-not required.
-
-On some platforms, for example Windows NT, it is not possible to
-unlink an open file (the file must be closed first). On those
-platforms, the actual unlinking is deferred until the program ends and
-good status is returned. A check is still performed to make sure that
-the filehandle and filename are pointing to the same thing (but not at
-the time the end block is executed since the deferred removal may not
-have access to the filehandle).
-
-Additionally, on Windows NT not all the fields returned by stat() can
-be compared. For example, the C<dev> and C<rdev> fields seem to be
-different. Also, it seems that the size of the file returned by stat()
-does not always agree, with C<stat(FH)> being more accurate than
-C<stat(filename)>, presumably because of caching issues even when
-using autoflush (this is usually overcome by waiting a while after
-writing to the tempfile before attempting to C<unlink0> it).
-
-Finally, on NFS file systems the link count of the file handle does
-not always go to zero immediately after unlinking. Currently, this
-command is expected to fail on NFS disks.
-
-This function is disabled if the global variable $KEEP_ALL is true
-and an unlink on open file is supported. If the unlink is to be deferred
-to the END block, the file is still registered for removal.
-
-This function should not be called if you are using the object oriented
-interface since the it will interfere with the object destructor deleting
-the file.
-
-=cut
-
-sub unlink0 {
-
- croak 'Usage: unlink0(filehandle, filename)'
- unless scalar(@_) == 2;
-
- # Read args
- my ($fh, $path) = @_;
-
- cmpstat($fh, $path) or return 0;
-
- # attempt remove the file (does not work on some platforms)
- if (_can_unlink_opened_file()) {
-
- # return early (Without unlink) if we have been instructed to retain files.
- return 1 if $KEEP_ALL;
-
- # XXX: do *not* call this on a directory; possible race
- # resulting in recursive removal
- croak "unlink0: $path has become a directory!" if -d $path;
- unlink($path) or return 0;
-
- # Stat the filehandle
- my @fh = stat $fh;
-
- print "Link count = $fh[3] \n" if $DEBUG;
-
- # Make sure that the link count is zero
- # - Cygwin provides deferred unlinking, however,
- # on Win9x the link count remains 1
- # On NFS the link count may still be 1 but we cant know that
- # we are on NFS
- return ( $fh[3] == 0 or $^O eq 'cygwin' ? 1 : 0);
-
- } else {
- _deferred_unlink($fh, $path, 0);
- return 1;
- }
-
-}
-
-=item B<cmpstat>
-
-Compare C<stat> of filehandle with C<stat> of provided filename. This
-can be used to check that the filename and filehandle initially point
-to the same file and that the number of links to the file is 1 (all
-fields returned by stat() are compared).
-
- cmpstat($fh, $path)
- or die "Error comparing handle with file";
-
-Returns false if the stat information differs or if the link count is
-greater than 1. Calls croak if there is a security anomaly.
-
-On certain platforms, for example Windows, not all the fields returned by stat()
-can be compared. For example, the C<dev> and C<rdev> fields seem to be
-different in Windows. Also, it seems that the size of the file
-returned by stat() does not always agree, with C<stat(FH)> being more
-accurate than C<stat(filename)>, presumably because of caching issues
-even when using autoflush (this is usually overcome by waiting a while
-after writing to the tempfile before attempting to C<unlink0> it).
-
-Not exported by default.
-
-=cut
-
-sub cmpstat {
-
- croak 'Usage: cmpstat(filehandle, filename)'
- unless scalar(@_) == 2;
-
- # Read args
- my ($fh, $path) = @_;
-
- warn "Comparing stat\n"
- if $DEBUG;
-
- # Stat the filehandle - which may be closed if someone has manually
- # closed the file. Can not turn off warnings without using $^W
- # unless we upgrade to 5.006 minimum requirement
- my @fh;
- {
- local ($^W) = 0;
- @fh = stat $fh;
- }
- return unless @fh;
-
- if ($fh[3] > 1 && $^W) {
- carp "unlink0: fstat found too many links; SB=@fh" if $^W;
- }
-
- # Stat the path
- my @path = stat $path;
-
- unless (@path) {
- carp "unlink0: $path is gone already" if $^W;
- return;
- }
-
- # this is no longer a file, but may be a directory, or worse
- unless (-f $path) {
- confess "panic: $path is no longer a file: SB=@fh";
- }
-
- # Do comparison of each member of the array
- # On WinNT dev and rdev seem to be different
- # depending on whether it is a file or a handle.
- # Cannot simply compare all members of the stat return
- # Select the ones we can use
- my @okstat = (0..$#fh); # Use all by default
- if ($^O eq 'MSWin32') {
- @okstat = (1,2,3,4,5,7,8,9,10);
- } elsif ($^O eq 'os2') {
- @okstat = (0, 2..$#fh);
- } elsif ($^O eq 'VMS') { # device and file ID are sufficient
- @okstat = (0, 1);
- } elsif ($^O eq 'dos') {
- @okstat = (0,2..7,11..$#fh);
- } elsif ($^O eq 'mpeix') {
- @okstat = (0..4,8..10);
- }
-
- # Now compare each entry explicitly by number
- for (@okstat) {
- print "Comparing: $_ : $fh[$_] and $path[$_]\n" if $DEBUG;
- # Use eq rather than == since rdev, blksize, and blocks (6, 11,
- # and 12) will be '' on platforms that do not support them. This
- # is fine since we are only comparing integers.
- unless ($fh[$_] eq $path[$_]) {
- warn "Did not match $_ element of stat\n" if $DEBUG;
- return 0;
- }
- }
-
- return 1;
-}
-
-=item B<unlink1>
-
-Similar to C<unlink0> except after file comparison using cmpstat, the
-filehandle is closed prior to attempting to unlink the file. This
-allows the file to be removed without using an END block, but does
-mean that the post-unlink comparison of the filehandle state provided
-by C<unlink0> is not available.
-
- unlink1($fh, $path)
- or die "Error closing and unlinking file";
-
-Usually called from the object destructor when using the OO interface.
-
-Not exported by default.
-
-This function is disabled if the global variable $KEEP_ALL is true.
-
-Can call croak() if there is a security anomaly during the stat()
-comparison.
-
-=cut
-
-sub unlink1 {
- croak 'Usage: unlink1(filehandle, filename)'
- unless scalar(@_) == 2;
-
- # Read args
- my ($fh, $path) = @_;
-
- cmpstat($fh, $path) or return 0;
-
- # Close the file
- close( $fh ) or return 0;
-
- # Make sure the file is writable (for windows)
- _force_writable( $path );
-
- # return early (without unlink) if we have been instructed to retain files.
- return 1 if $KEEP_ALL;
-
- # remove the file
- return unlink($path);
-}
-
-=item B<cleanup>
-
-Calling this function will cause any temp files or temp directories
-that are registered for removal to be removed. This happens automatically
-when the process exits but can be triggered manually if the caller is sure
-that none of the temp files are required. This method can be registered as
-an Apache callback.
-
-On OSes where temp files are automatically removed when the temp file
-is closed, calling this function will have no effect other than to remove
-temporary directories (which may include temporary files).
-
- File::Temp::cleanup();
-
-Not exported by default.
-
-=back
-
-=head1 PACKAGE VARIABLES
-
-These functions control the global state of the package.
-
-=over 4
-
-=item B<safe_level>
-
-Controls the lengths to which the module will go to check the safety of the
-temporary file or directory before proceeding.
-Options are:
-
-=over 8
-
-=item STANDARD
-
-Do the basic security measures to ensure the directory exists and is
-writable, that temporary files are opened only if they do not already
-exist, and that possible race conditions are avoided. Finally the
-L<unlink0|"unlink0"> function is used to remove files safely.
-
-=item MEDIUM
-
-In addition to the STANDARD security, the output directory is checked
-to make sure that it is owned either by root or the user running the
-program. If the directory is writable by group or by other, it is then
-checked to make sure that the sticky bit is set.
-
-Will not work on platforms that do not support the C<-k> test
-for sticky bit.
-
-=item HIGH
-
-In addition to the MEDIUM security checks, also check for the
-possibility of ``chown() giveaway'' using the L<POSIX|POSIX>
-sysconf() function. If this is a possibility, each directory in the
-path is checked in turn for safeness, recursively walking back to the
-root directory.
-
-For platforms that do not support the L<POSIX|POSIX>
-C<_PC_CHOWN_RESTRICTED> symbol (for example, Windows NT) it is
-assumed that ``chown() giveaway'' is possible and the recursive test
-is performed.
-
-=back
-
-The level can be changed as follows:
-
- File::Temp->safe_level( File::Temp::HIGH );
-
-The level constants are not exported by the module.
-
-Currently, you must be running at least perl v5.6.0 in order to
-run with MEDIUM or HIGH security. This is simply because the
-safety tests use functions from L<Fcntl|Fcntl> that are not
-available in older versions of perl. The problem is that the version
-number for Fcntl is the same in perl 5.6.0 and in 5.005_03 even though
-they are different versions.
-
-On systems that do not support the HIGH or MEDIUM safety levels
-(for example Win NT or OS/2) any attempt to change the level will
-be ignored. The decision to ignore rather than raise an exception
-allows portable programs to be written with high security in mind
-for the systems that can support this without those programs failing
-on systems where the extra tests are irrelevant.
-
-If you really need to see whether the change has been accepted
-simply examine the return value of C<safe_level>.
-
- $newlevel = File::Temp->safe_level( File::Temp::HIGH );
- die "Could not change to high security"
- if $newlevel != File::Temp::HIGH;
-
-=cut
-
-{
- # protect from using the variable itself
- my $LEVEL = STANDARD;
- sub safe_level {
- my $self = shift;
- if (@_) {
- my $level = shift;
- if (($level != STANDARD) && ($level != MEDIUM) && ($level != HIGH)) {
- carp "safe_level: Specified level ($level) not STANDARD, MEDIUM or HIGH - ignoring\n" if $^W;
- } else {
- # Dont allow this on perl 5.005 or earlier
- if ($] < 5.006 && $level != STANDARD) {
- # Cant do MEDIUM or HIGH checks
- croak "Currently requires perl 5.006 or newer to do the safe checks";
- }
- # Check that we are allowed to change level
- # Silently ignore if we can not.
- $LEVEL = $level if _can_do_level($level);
- }
- }
- return $LEVEL;
- }
-}
-
-=item TopSystemUID
-
-This is the highest UID on the current system that refers to a root
-UID. This is used to make sure that the temporary directory is
-owned by a system UID (C<root>, C<bin>, C<sys> etc) rather than
-simply by root.
-
-This is required since on many unix systems C</tmp> is not owned
-by root.
-
-Default is to assume that any UID less than or equal to 10 is a root
-UID.
-
- File::Temp->top_system_uid(10);
- my $topid = File::Temp->top_system_uid;
-
-This value can be adjusted to reduce security checking if required.
-The value is only relevant when C<safe_level> is set to MEDIUM or higher.
-
-=cut
-
-{
- my $TopSystemUID = 10;
- $TopSystemUID = 197108 if $^O eq 'interix'; # "Administrator"
- sub top_system_uid {
- my $self = shift;
- if (@_) {
- my $newuid = shift;
- croak "top_system_uid: UIDs should be numeric"
- unless $newuid =~ /^\d+$/s;
- $TopSystemUID = $newuid;
- }
- return $TopSystemUID;
- }
-}
-
-=item B<$KEEP_ALL>
-
-Controls whether temporary files and directories should be retained
-regardless of any instructions in the program to remove them
-automatically. This is useful for debugging but should not be used in
-production code.
-
- $File::Temp::KEEP_ALL = 1;
-
-Default is for files to be removed as requested by the caller.
-
-In some cases, files will only be retained if this variable is true
-when the file is created. This means that you can not create a temporary
-file, set this variable and expect the temp file to still be around
-when the program exits.
-
-=item B<$DEBUG>
-
-Controls whether debugging messages should be enabled.
-
- $File::Temp::DEBUG = 1;
-
-Default is for debugging mode to be disabled.
-
-=back
-
-=head1 WARNING
-
-For maximum security, endeavour always to avoid ever looking at,
-touching, or even imputing the existence of the filename. You do not
-know that that filename is connected to the same file as the handle
-you have, and attempts to check this can only trigger more race
-conditions. It's far more secure to use the filehandle alone and
-dispense with the filename altogether.
-
-If you need to pass the handle to something that expects a filename
-then, on a unix system, use C<"/dev/fd/" . fileno($fh)> for arbitrary
-programs, or more generally C<< "+<=&" . fileno($fh) >> for Perl
-programs. You will have to clear the close-on-exec bit on that file
-descriptor before passing it to another process.
-
- use Fcntl qw/F_SETFD F_GETFD/;
- fcntl($tmpfh, F_SETFD, 0)
- or die "Can't clear close-on-exec flag on temp fh: $!\n";
-
-=head2 Temporary files and NFS
-
-Some problems are associated with using temporary files that reside
-on NFS file systems and it is recommended that a local filesystem
-is used whenever possible. Some of the security tests will most probably
-fail when the temp file is not local. Additionally, be aware that
-the performance of I/O operations over NFS will not be as good as for
-a local disk.
-
-=head2 Forking
-
-In some cases files created by File::Temp are removed from within an
-END block. Since END blocks are triggered when a child process exits
-(unless C<POSIX::_exit()> is used by the child) File::Temp takes care
-to only remove those temp files created by a particular process ID. This
-means that a child will not attempt to remove temp files created by the
-parent process.
-
-If you are forking many processes in parallel that are all creating
-temporary files, you may need to reset the random number seed using
-srand(EXPR) in each child else all the children will attempt to walk
-through the same set of random file names and may well cause
-themselves to give up if they exceed the number of retry attempts.
-
-=head2 BINMODE
-
-The file returned by File::Temp will have been opened in binary mode
-if such a mode is available. If that is not correct, use the C<binmode()>
-function to change the mode of the filehandle.
-
-Note that you can modify the encoding of a file opened by File::Temp
-also by using C<binmode()>.
-
-=head1 HISTORY
-
-Originally began life in May 1999 as an XS interface to the system
-mkstemp() function. In March 2000, the OpenBSD mkstemp() code was
-translated to Perl for total control of the code's
-security checking, to ensure the presence of the function regardless of
-operating system and to help with portability. The module was shipped
-as a standard part of perl from v5.6.1.
-
-=head1 SEE ALSO
-
-L<POSIX/tmpnam>, L<POSIX/tmpfile>, L<File::Spec>, L<File::Path>
-
-See L<IO::File> and L<File::MkTemp>, L<Apache::TempFile> for
-different implementations of temporary file handling.
-
-See L<File::Tempdir> for an alternative object-oriented wrapper for
-the C<tempdir> function.
-
-=head1 AUTHOR
-
-Tim Jenness E<lt>tjenness@cpan.orgE<gt>
-
-Copyright (C) 2007 Tim Jenness.
-Copyright (C) 1999-2007 Tim Jenness and the UK Particle Physics and
-Astronomy Research Council. All Rights Reserved. This program is free
-software; you can redistribute it and/or modify it under the same
-terms as Perl itself.
-
-Original Perl implementation loosely based on the OpenBSD C code for
-mkstemp(). Thanks to Tom Christiansen for suggesting that this module
-should be written and providing ideas for code improvements and
-security enhancements.
-
-=cut
-
-package File::Temp::Dir;
-
-use File::Path qw/ rmtree /;
-use strict;
-use overload '""' => "STRINGIFY", fallback => 1;
-
-# private class specifically to support tempdir objects
-# created by File::Temp->newdir
-
-# ostensibly the same method interface as File::Temp but without
-# inheriting all the IO::Seekable methods and other cruft
-
-# Read-only - returns the name of the temp directory
-
-sub dirname {
- my $self = shift;
- return $self->{DIRNAME};
-}
-
-sub STRINGIFY {
- my $self = shift;
- return $self->dirname;
-}
-
-sub unlink_on_destroy {
- my $self = shift;
- if (@_) {
- $self->{CLEANUP} = shift;
- }
- return $self->{CLEANUP};
-}
-
-sub DESTROY {
- my $self = shift;
- if ($self->unlink_on_destroy &&
- $$ == $self->{LAUNCHPID} && !$File::Temp::KEEP_ALL) {
- rmtree($self->{DIRNAME}, $File::Temp::DEBUG, 0)
- if -d $self->{DIRNAME};
- }
-}
-
-
-1;
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/File/pushd.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/File/pushd.pm
deleted file mode 100644
index 0c3666d3d9d..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/File/pushd.pm
+++ /dev/null
@@ -1,229 +0,0 @@
-package File::pushd;
-
-$VERSION = '1.00';
-@EXPORT = qw( pushd tempd );
-@ISA = qw( Exporter );
-
-use 5.004;
-use strict;
-#use warnings;
-use Exporter;
-use Carp;
-use Cwd qw( cwd abs_path );
-use File::Path qw( rmtree );
-use File::Temp qw();
-use File::Spec;
-
-use overload
- q{""} => sub { File::Spec->canonpath( $_[0]->{_pushd} ) },
- fallback => 1;
-
-#--------------------------------------------------------------------------#
-# pushd()
-#--------------------------------------------------------------------------#
-
-sub pushd {
- my ($target_dir) = @_;
-
- my $orig = cwd;
-
- my $dest;
- eval { $dest = $target_dir ? abs_path( $target_dir ) : $orig };
-
- croak "Can't locate directory $target_dir: $@" if $@;
-
- if ($dest ne $orig) {
- chdir $dest or croak "Can't chdir to $dest\: $!";
- }
-
- my $self = bless {
- _pushd => $dest,
- _original => $orig
- }, __PACKAGE__;
-
- return $self;
-}
-
-#--------------------------------------------------------------------------#
-# tempd()
-#--------------------------------------------------------------------------#
-
-sub tempd {
- my $dir = pushd( File::Temp::tempdir( CLEANUP => 0 ) );
- $dir->{_tempd} = 1;
- return $dir;
-}
-
-#--------------------------------------------------------------------------#
-# preserve()
-#--------------------------------------------------------------------------#
-
-sub preserve {
- my $self = shift;
- return 1 if ! $self->{"_tempd"};
- if ( @_ == 0 ) {
- return $self->{_preserve} = 1;
- }
- else {
- return $self->{_preserve} = $_[0] ? 1 : 0;
- }
-}
-
-#--------------------------------------------------------------------------#
-# DESTROY()
-# Revert to original directory as object is destroyed and cleanup
-# if necessary
-#--------------------------------------------------------------------------#
-
-sub DESTROY {
- my ($self) = @_;
- my $orig = $self->{_original};
- chdir $orig if $orig; # should always be so, but just in case...
- if ( $self->{_tempd} &&
- !$self->{_preserve} ) {
- eval { rmtree( $self->{_pushd} ) };
- carp $@ if $@;
- }
-}
-
-1; #this line is important and will help the module return a true value
-__END__
-
-=begin wikidoc
-
-= NAME
-
-File::pushd - change directory temporarily for a limited scope
-
-= VERSION
-
-This documentation describes version %%VERSION%%.
-
-= SYNOPSIS
-
- use File::pushd;
-
- chdir $ENV{HOME};
-
- # change directory again for a limited scope
- {
- my $dir = pushd( '/tmp' );
- # working directory changed to /tmp
- }
- # working directory has reverted to $ENV{HOME}
-
- # tempd() is equivalent to pushd( File::Temp::tempdir )
- {
- my $dir = tempd();
- }
-
- # object stringifies naturally as an absolute path
- {
- my $dir = pushd( '/tmp' );
- my $filename = File::Spec->catfile( $dir, "somefile.txt" );
- # gives /tmp/somefile.txt
- }
-
-= DESCRIPTION
-
-File::pushd does a temporary {chdir} that is easily and automatically
-reverted, similar to {pushd} in some Unix command shells. It works by
-creating an object that caches the original working directory. When the object
-is destroyed, the destructor calls {chdir} to revert to the original working
-directory. By storing the object in a lexical variable with a limited scope,
-this happens automatically at the end of the scope.
-
-This is very handy when working with temporary directories for tasks like
-testing; a function is provided to streamline getting a temporary
-directory from [File::Temp].
-
-For convenience, the object stringifies as the canonical form of the absolute
-pathname of the directory entered.
-
-= USAGE
-
- use File::pushd;
-
-Using File::pushd automatically imports the {pushd} and {tempd} functions.
-
-== pushd
-
- {
- my $dir = pushd( $target_directory );
- }
-
-Caches the current working directory, calls {chdir} to change to the target
-directory, and returns a File::pushd object. When the object is
-destroyed, the working directory reverts to the original directory.
-
-The provided target directory can be a relative or absolute path. If
-called with no arguments, it uses the current directory as its target and
-returns to the current directory when the object is destroyed.
-
-== tempd
-
- {
- my $dir = tempd();
- }
-
-This function is like {pushd} but automatically creates and calls {chdir} to
-a temporary directory created by [File::Temp]. Unlike normal [File::Temp]
-cleanup which happens at the end of the program, this temporary directory is
-removed when the object is destroyed. (But also see {preserve}.) A warning
-will be issued if the directory cannot be removed.
-
-== preserve
-
- {
- my $dir = tempd();
- $dir->preserve; # mark to preserve at end of scope
- $dir->preserve(0); # mark to delete at end of scope
- }
-
-Controls whether a temporary directory will be cleaned up when the object is
-destroyed. With no arguments, {preserve} sets the directory to be preserved.
-With an argument, the directory will be preserved if the argument is true, or
-marked for cleanup if the argument is false. Only {tempd} objects may be
-marked for cleanup. (Target directories to {pushd} are always preserved.)
-{preserve} returns true if the directory will be preserved, and false
-otherwise.
-
-= SEE ALSO
-
-* [File::chdir]
-
-= BUGS
-
-Please report any bugs or feature using the CPAN Request Tracker.
-Bugs can be submitted through the web interface at
-[http://rt.cpan.org/Dist/Display.html?Queue=File-pushd]
-
-When submitting a bug or request, please include a test-file or a patch to an
-existing test-file that illustrates the bug or desired feature.
-
-= AUTHOR
-
-David A. Golden (DAGOLDEN)
-
-= COPYRIGHT AND LICENSE
-
-Copyright (c) 2005, 2006, 2007 by David A. Golden
-
-Licensed under the Apache License, Version 2.0 (the "License");
-you may not use this file except in compliance with the License.
-You may obtain a copy of the License at
-[http://www.apache.org/licenses/LICENSE-2.0]
-
-Files produced as output though the use of this software, including
-generated copies of boilerplate templates provided with this software,
-shall not be considered Derivative Works, but shall be considered the
-original work of the Licensor.
-
-Unless required by applicable law or agreed to in writing, software
-distributed under the License is distributed on an "AS IS" BASIS,
-WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-See the License for the specific language governing permissions and
-limitations under the License.
-
-=end wikidoc
-
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/File/pushd.pod b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/File/pushd.pod
deleted file mode 100644
index 068fa4b1e77..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/File/pushd.pod
+++ /dev/null
@@ -1,145 +0,0 @@
-# Generated by Pod::WikiDoc version 0.17
-
-=pod
-
-=head1 NAME
-
-File::pushd - change directory temporarily for a limited scope
-
-=head1 VERSION
-
-This documentation describes version 1.00.
-
-=head1 SYNOPSIS
-
- use File::pushd;
-
- chdir $ENV{HOME};
-
- # change directory again for a limited scope
- {
- my $dir = pushd( '/tmp' );
- # working directory changed to /tmp
- }
- # working directory has reverted to $ENV{HOME}
-
- # tempd() is equivalent to pushd( File::Temp::tempdir )
- {
- my $dir = tempd();
- }
-
- # object stringifies naturally as an absolute path
- {
- my $dir = pushd( '/tmp' );
- my $filename = File::Spec->catfile( $dir, "somefile.txt" );
- # gives /tmp/somefile.txt
- }
-
-=head1 DESCRIPTION
-
-File::pushd does a temporary C<<< chdir >>> that is easily and automatically
-reverted, similar to C<<< pushd >>> in some Unix command shells. It works by
-creating an object that caches the original working directory. When the object
-is destroyed, the destructor calls C<<< chdir >>> to revert to the original working
-directory. By storing the object in a lexical variable with a limited scope,
-this happens automatically at the end of the scope.
-
-This is very handy when working with temporary directories for tasks like
-testing; a function is provided to streamline getting a temporary
-directory from L<File::Temp>.
-
-For convenience, the object stringifies as the canonical form of the absolute
-pathname of the directory entered.
-
-=head1 USAGE
-
- use File::pushd;
-
-Using File::pushd automatically imports the C<<< pushd >>> and C<<< tempd >>> functions.
-
-=head2 pushd
-
- {
- my $dir = pushd( $target_directory );
- }
-
-Caches the current working directory, calls C<<< chdir >>> to change to the target
-directory, and returns a File::pushd object. When the object is
-destroyed, the working directory reverts to the original directory.
-
-The provided target directory can be a relative or absolute path. If
-called with no arguments, it uses the current directory as its target and
-returns to the current directory when the object is destroyed.
-
-=head2 tempd
-
- {
- my $dir = tempd();
- }
-
-This function is like C<<< pushd >>> but automatically creates and calls C<<< chdir >>> to
-a temporary directory created by L<File::Temp>. Unlike normal L<File::Temp>
-cleanup which happens at the end of the program, this temporary directory is
-removed when the object is destroyed. (But also see C<<< preserve >>>.) A warning
-will be issued if the directory cannot be removed.
-
-=head2 preserve
-
- {
- my $dir = tempd();
- $dir->preserve; # mark to preserve at end of scope
- $dir->preserve(0); # mark to delete at end of scope
- }
-
-Controls whether a temporary directory will be cleaned up when the object is
-destroyed. With no arguments, C<<< preserve >>> sets the directory to be preserved.
-With an argument, the directory will be preserved if the argument is true, or
-marked for cleanup if the argument is false. Only C<<< tempd >>> objects may be
-marked for cleanup. (Target directories to C<<< pushd >>> are always preserved.)
-C<<< preserve >>> returns true if the directory will be preserved, and false
-otherwise.
-
-=head1 SEE ALSO
-
-=over
-
-=item *
-
-L<File::chdir>
-
-=back
-
-=head1 BUGS
-
-Please report any bugs or feature using the CPAN Request Tracker.
-Bugs can be submitted through the web interface at
-L<http://rt.cpan.org/Dist/Display.html?Queue=File-pushd>
-
-When submitting a bug or request, please include a test-file or a patch to an
-existing test-file that illustrates the bug or desired feature.
-
-=head1 AUTHOR
-
-David A. Golden (DAGOLDEN)
-
-=head1 COPYRIGHT AND LICENSE
-
-Copyright (c) 2005, 2006, 2007 by David A. Golden
-
-Licensed under the Apache License, Version 2.0 (the "License");
-you may not use this file except in compliance with the License.
-You may obtain a copy of the License at
-L<http://www.apache.org/licenses/LICENSE-2.0>
-
-Files produced as output though the use of this software, including
-generated copies of boilerplate templates provided with this software,
-shall not be considered Derivative Works, but shall be considered the
-original work of the Licensor.
-
-Unless required by applicable law or agreed to in writing, software
-distributed under the License is distributed on an "AS IS" BASIS,
-WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-See the License for the specific language governing permissions and
-limitations under the License.
-
-
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/HTML/Form.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/HTML/Form.pm
deleted file mode 100644
index e539cfa408f..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/HTML/Form.pm
+++ /dev/null
@@ -1,1400 +0,0 @@
-package HTML::Form;
-
-use strict;
-use URI;
-use Carp ();
-
-use vars qw($VERSION);
-$VERSION = "5.813";
-
-my %form_tags = map {$_ => 1} qw(input textarea button select option);
-
-my %type2class = (
- text => "TextInput",
- password => "TextInput",
- hidden => "TextInput",
- textarea => "TextInput",
-
- "reset" => "IgnoreInput",
-
- radio => "ListInput",
- checkbox => "ListInput",
- option => "ListInput",
-
- button => "SubmitInput",
- submit => "SubmitInput",
- image => "ImageInput",
- file => "FileInput",
-
- keygen => "KeygenInput",
-);
-
-=head1 NAME
-
-HTML::Form - Class that represents an HTML form element
-
-=head1 SYNOPSIS
-
- use HTML::Form;
- $form = HTML::Form->parse($html, $base_uri);
- $form->value(query => "Perl");
-
- use LWP::UserAgent;
- $ua = LWP::UserAgent->new;
- $response = $ua->request($form->click);
-
-=head1 DESCRIPTION
-
-Objects of the C<HTML::Form> class represents a single HTML
-C<E<lt>formE<gt> ... E<lt>/formE<gt>> instance. A form consists of a
-sequence of inputs that usually have names, and which can take on
-various values. The state of a form can be tweaked and it can then be
-asked to provide C<HTTP::Request> objects that can be passed to the
-request() method of C<LWP::UserAgent>.
-
-The following methods are available:
-
-=over 4
-
-=item @forms = HTML::Form->parse( $response )
-
-=item @forms = HTML::Form->parse( $html_document, $base )
-
-=item @forms = HTML::Form->parse( $html_document, %opt )
-
-The parse() class method will parse an HTML document and build up
-C<HTML::Form> objects for each <form> element found. If called in scalar
-context only returns the first <form>. Returns an empty list if there
-are no forms to be found.
-
-The $base is the URI used to retrieve the $html_document. It is
-needed to resolve relative action URIs. If the document was retrieved
-with LWP then this this parameter is obtained from the
-$response->base() method, as shown by the following example:
-
- my $ua = LWP::UserAgent->new;
- my $response = $ua->get("http://www.example.com/form.html");
- my @forms = HTML::Form->parse($response->decoded_content,
- $response->base);
-
-The parse() method can parse from an C<HTTP::Response> object
-directly, so the example above can be more conveniently written as:
-
- my $ua = LWP::UserAgent->new;
- my $response = $ua->get("http://www.example.com/form.html");
- my @forms = HTML::Form->parse($response);
-
-Note that any object that implements a decoded_content() and base() method
-with similar behaviour as C<HTTP::Response> will do.
-
-Finally options might be passed in to control how the parse method
-behaves. The following options are currently recognized:
-
-=over
-
-=item C<base>
-
-Another way to provide the base URI.
-
-=item C<verbose>
-
-Print messages to STDERR about any bad HTML form constructs found.
-
-=back
-
-=cut
-
-sub parse
-{
- my $class = shift;
- my $html = shift;
- unshift(@_, "base") if @_ == 1;
- my %opt = @_;
-
- require HTML::TokeParser;
- my $p = HTML::TokeParser->new(ref($html) ? $html->decoded_content(ref => 1) : \$html);
- die "Failed to create HTML::TokeParser object" unless $p;
- eval {
- # optimization
- $p->report_tags(qw(form input textarea select optgroup option keygen label button));
- };
-
- my $base_uri = delete $opt{base};
- my $verbose = delete $opt{verbose};
-
- if ($^W) {
- Carp::carp("Unrecognized option $_ in HTML::Form->parse") for sort keys %opt;
- }
-
- unless (defined $base_uri) {
- if (ref($html)) {
- $base_uri = $html->base;
- }
- else {
- Carp::croak("HTML::Form::parse: No \$base_uri provided");
- }
- }
-
- my @forms;
- my $f; # current form
-
- my %openselect; # index to the open instance of a select
-
- while (my $t = $p->get_tag) {
- my($tag,$attr) = @$t;
- if ($tag eq "form") {
- my $action = delete $attr->{'action'};
- $action = "" unless defined $action;
- $action = URI->new_abs($action, $base_uri);
- $f = $class->new($attr->{'method'},
- $action,
- $attr->{'enctype'});
- $f->{attr} = $attr;
- %openselect = ();
- push(@forms, $f);
- my(%labels, $current_label);
- while (my $t = $p->get_tag) {
- my($tag, $attr) = @$t;
- last if $tag eq "/form";
-
- # if we are inside a label tag, then keep
- # appending any text to the current label
- if(defined $current_label) {
- $current_label = join " ",
- grep { defined and length }
- $current_label,
- $p->get_phrase;
- }
-
- if ($tag eq "input") {
- $attr->{value_name} =
- exists $attr->{id} && exists $labels{$attr->{id}} ? $labels{$attr->{id}} :
- defined $current_label ? $current_label :
- $p->get_phrase;
- }
-
- if ($tag eq "label") {
- $current_label = $p->get_phrase;
- $labels{ $attr->{for} } = $current_label
- if exists $attr->{for};
- }
- elsif ($tag eq "/label") {
- $current_label = undef;
- }
- elsif ($tag eq "input") {
- my $type = delete $attr->{type} || "text";
- $f->push_input($type, $attr);
- }
- elsif ($tag eq "button") {
- my $type = delete $attr->{type} || "submit";
- $f->push_input($type, $attr);
- }
- elsif ($tag eq "textarea") {
- $attr->{textarea_value} = $attr->{value}
- if exists $attr->{value};
- my $text = $p->get_text("/textarea");
- $attr->{value} = $text;
- $f->push_input("textarea", $attr);
- }
- elsif ($tag eq "select") {
- # rename attributes reserved to come for the option tag
- for ("value", "value_name") {
- $attr->{"select_$_"} = delete $attr->{$_}
- if exists $attr->{$_};
- }
- # count this new select option separately
- $openselect{$attr->{name}}++;
-
- while ($t = $p->get_tag) {
- my $tag = shift @$t;
- last if $tag eq "/select";
- next if $tag =~ m,/?optgroup,;
- next if $tag eq "/option";
- if ($tag eq "option") {
- my %a = %{$t->[0]};
- # rename keys so they don't clash with %attr
- for (keys %a) {
- next if $_ eq "value";
- $a{"option_$_"} = delete $a{$_};
- }
- while (my($k,$v) = each %$attr) {
- $a{$k} = $v;
- }
- $a{value_name} = $p->get_trimmed_text;
- $a{value} = delete $a{value_name}
- unless defined $a{value};
- $a{idx} = $openselect{$attr->{name}};
- $f->push_input("option", \%a);
- }
- else {
- warn("Bad <select> tag '$tag' in $base_uri\n") if $verbose;
- if ($tag eq "/form" ||
- $tag eq "input" ||
- $tag eq "textarea" ||
- $tag eq "select" ||
- $tag eq "keygen")
- {
- # MSIE implictly terminate the <select> here, so we
- # try to do the same. Actually the MSIE behaviour
- # appears really strange: <input> and <textarea>
- # do implictly close, but not <select>, <keygen> or
- # </form>.
- my $type = ($tag =~ s,^/,,) ? "E" : "S";
- $p->unget_token([$type, $tag, @$t]);
- last;
- }
- }
- }
- }
- elsif ($tag eq "keygen") {
- $f->push_input("keygen", $attr);
- }
- }
- }
- elsif ($form_tags{$tag}) {
- warn("<$tag> outside <form> in $base_uri\n") if $verbose;
- }
- }
- for (@forms) {
- $_->fixup;
- }
-
- wantarray ? @forms : $forms[0];
-}
-
-sub new {
- my $class = shift;
- my $self = bless {}, $class;
- $self->{method} = uc(shift || "GET");
- $self->{action} = shift || Carp::croak("No action defined");
- $self->{enctype} = lc(shift || "application/x-www-form-urlencoded");
- $self->{inputs} = [@_];
- $self;
-}
-
-
-sub push_input
-{
- my($self, $type, $attr) = @_;
- $type = lc $type;
- my $class = $type2class{$type};
- unless ($class) {
- Carp::carp("Unknown input type '$type'") if $^W;
- $class = "TextInput";
- }
- $class = "HTML::Form::$class";
- my @extra;
- push(@extra, readonly => 1) if $type eq "hidden";
-
- delete $attr->{type}; # don't confuse the type argument
- my $input = $class->new(type => $type, %$attr, @extra);
- $input->add_to_form($self);
-}
-
-
-=item $method = $form->method
-
-=item $form->method( $new_method )
-
-This method is gets/sets the I<method> name used for the
-C<HTTP::Request> generated. It is a string like "GET" or "POST".
-
-=item $action = $form->action
-
-=item $form->action( $new_action )
-
-This method gets/sets the URI which we want to apply the request
-I<method> to.
-
-=item $enctype = $form->enctype
-
-=item $form->enctype( $new_enctype )
-
-This method gets/sets the encoding type for the form data. It is a
-string like "application/x-www-form-urlencoded" or "multipart/form-data".
-
-=cut
-
-BEGIN {
- # Set up some accesor
- for (qw(method action enctype)) {
- my $m = $_;
- no strict 'refs';
- *{$m} = sub {
- my $self = shift;
- my $old = $self->{$m};
- $self->{$m} = shift if @_;
- $old;
- };
- }
- *uri = \&action; # alias
-}
-
-=item $value = $form->attr( $name )
-
-=item $form->attr( $name, $new_value )
-
-This method give access to the original HTML attributes of the <form> tag.
-The $name should always be passed in lower case.
-
-Example:
-
- @f = HTML::Form->parse( $html, $foo );
- @f = grep $_->attr("id") eq "foo", @f;
- die "No form named 'foo' found" unless @f;
- $foo = shift @f;
-
-=cut
-
-sub attr {
- my $self = shift;
- my $name = shift;
- return undef unless defined $name;
-
- my $old = $self->{attr}{$name};
- $self->{attr}{$name} = shift if @_;
- return $old;
-}
-
-=item @inputs = $form->inputs
-
-This method returns the list of inputs in the form. If called in
-scalar context it returns the number of inputs contained in the form.
-See L</INPUTS> for what methods are available for the input objects
-returned.
-
-=cut
-
-sub inputs
-{
- my $self = shift;
- @{$self->{'inputs'}};
-}
-
-
-=item $input = $form->find_input( $name )
-
-=item $input = $form->find_input( $name, $type )
-
-=item $input = $form->find_input( $name, $type, $index )
-
-This method is used to locate specific inputs within the form. All
-inputs that match the arguments given are returned. In scalar context
-only the first is returned, or C<undef> if none match.
-
-If $name is specified, then the input must have the indicated name.
-
-If $type is specified, then the input must have the specified type.
-The following type names are used: "text", "password", "hidden",
-"textarea", "file", "image", "submit", "radio", "checkbox" and "option".
-
-The $index is the sequence number of the input matched where 1 is the
-first. If combined with $name and/or $type then it select the I<n>th
-input with the given name and/or type.
-
-=cut
-
-sub find_input
-{
- my($self, $name, $type, $no) = @_;
- if (wantarray) {
- my @res;
- my $c;
- for (@{$self->{'inputs'}}) {
- if (defined $name) {
- next unless exists $_->{name};
- next if $name ne $_->{name};
- }
- next if $type && $type ne $_->{type};
- $c++;
- next if $no && $no != $c;
- push(@res, $_);
- }
- return @res;
-
- }
- else {
- $no ||= 1;
- for (@{$self->{'inputs'}}) {
- if (defined $name) {
- next unless exists $_->{name};
- next if $name ne $_->{name};
- }
- next if $type && $type ne $_->{type};
- next if --$no;
- return $_;
- }
- return undef;
- }
-}
-
-sub fixup
-{
- my $self = shift;
- for (@{$self->{'inputs'}}) {
- $_->fixup;
- }
-}
-
-
-=item $value = $form->value( $name )
-
-=item $form->value( $name, $new_value )
-
-The value() method can be used to get/set the value of some input. If
-no input has the indicated name, then this method will croak.
-
-If multiple inputs have the same name, only the first one will be
-affected.
-
-The call:
-
- $form->value('foo')
-
-is a short-hand for:
-
- $form->find_input('foo')->value;
-
-=cut
-
-sub value
-{
- my $self = shift;
- my $key = shift;
- my $input = $self->find_input($key);
- Carp::croak("No such field '$key'") unless $input;
- local $Carp::CarpLevel = 1;
- $input->value(@_);
-}
-
-=item @names = $form->param
-
-=item @values = $form->param( $name )
-
-=item $form->param( $name, $value, ... )
-
-=item $form->param( $name, \@values )
-
-Alternative interface to examining and setting the values of the form.
-
-If called without arguments then it returns the names of all the
-inputs in the form. The names will not repeat even if multiple inputs
-have the same name. In scalar context the number of different names
-is returned.
-
-If called with a single argument then it returns the value or values
-of inputs with the given name. If called in scalar context only the
-first value is returned. If no input exists with the given name, then
-C<undef> is returned.
-
-If called with 2 or more arguments then it will set values of the
-named inputs. This form will croak if no inputs have the given name
-or if any of the values provided does not fit. Values can also be
-provided as a reference to an array. This form will allow unsetting
-all values with the given name as well.
-
-This interface resembles that of the param() function of the CGI
-module.
-
-=cut
-
-sub param {
- my $self = shift;
- if (@_) {
- my $name = shift;
- my @inputs;
- for ($self->inputs) {
- my $n = $_->name;
- next if !defined($n) || $n ne $name;
- push(@inputs, $_);
- }
-
- if (@_) {
- # set
- die "No '$name' parameter exists" unless @inputs;
- my @v = @_;
- @v = @{$v[0]} if @v == 1 && ref($v[0]);
- while (@v) {
- my $v = shift @v;
- my $err;
- for my $i (0 .. @inputs-1) {
- eval {
- $inputs[$i]->value($v);
- };
- unless ($@) {
- undef($err);
- splice(@inputs, $i, 1);
- last;
- }
- $err ||= $@;
- }
- die $err if $err;
- }
-
- # the rest of the input should be cleared
- for (@inputs) {
- $_->value(undef);
- }
- }
- else {
- # get
- my @v;
- for (@inputs) {
- if (defined(my $v = $_->value)) {
- push(@v, $v);
- }
- }
- return wantarray ? @v : $v[0];
- }
- }
- else {
- # list parameter names
- my @n;
- my %seen;
- for ($self->inputs) {
- my $n = $_->name;
- next if !defined($n) || $seen{$n}++;
- push(@n, $n);
- }
- return @n;
- }
-}
-
-
-=item $form->try_others( \&callback )
-
-This method will iterate over all permutations of unvisited enumerated
-values (<select>, <radio>, <checkbox>) and invoke the callback for
-each. The callback is passed the $form as argument. The return value
-from the callback is ignored and the try_others() method itself does
-not return anything.
-
-=cut
-
-sub try_others
-{
- my($self, $cb) = @_;
- my @try;
- for (@{$self->{'inputs'}}) {
- my @not_tried_yet = $_->other_possible_values;
- next unless @not_tried_yet;
- push(@try, [\@not_tried_yet, $_]);
- }
- return unless @try;
- $self->_try($cb, \@try, 0);
-}
-
-sub _try
-{
- my($self, $cb, $try, $i) = @_;
- for (@{$try->[$i][0]}) {
- $try->[$i][1]->value($_);
- &$cb($self);
- $self->_try($cb, $try, $i+1) if $i+1 < @$try;
- }
-}
-
-
-=item $request = $form->make_request
-
-Will return an C<HTTP::Request> object that reflects the current setting
-of the form. You might want to use the click() method instead.
-
-=cut
-
-sub make_request
-{
- my $self = shift;
- my $method = uc $self->{'method'};
- my $uri = $self->{'action'};
- my $enctype = $self->{'enctype'};
- my @form = $self->form;
-
- if ($method eq "GET") {
- require HTTP::Request;
- $uri = URI->new($uri, "http");
- $uri->query_form(@form);
- return HTTP::Request->new(GET => $uri);
- }
- elsif ($method eq "POST") {
- require HTTP::Request::Common;
- return HTTP::Request::Common::POST($uri, \@form,
- Content_Type => $enctype);
- }
- else {
- Carp::croak("Unknown method '$method'");
- }
-}
-
-
-=item $request = $form->click
-
-=item $request = $form->click( $name )
-
-=item $request = $form->click( $x, $y )
-
-=item $request = $form->click( $name, $x, $y )
-
-Will "click" on the first clickable input (which will be of type
-C<submit> or C<image>). The result of clicking is an C<HTTP::Request>
-object that can then be passed to C<LWP::UserAgent> if you want to
-obtain the server response.
-
-If a $name is specified, we will click on the first clickable input
-with the given name, and the method will croak if no clickable input
-with the given name is found. If $name is I<not> specified, then it
-is ok if the form contains no clickable inputs. In this case the
-click() method returns the same request as the make_request() method
-would do.
-
-If there are multiple clickable inputs with the same name, then there
-is no way to get the click() method of the C<HTML::Form> to click on
-any but the first. If you need this you would have to locate the
-input with find_input() and invoke the click() method on the given
-input yourself.
-
-A click coordinate pair can also be provided, but this only makes a
-difference if you clicked on an image. The default coordinate is
-(1,1). The upper-left corner of the image is (0,0), but some badly
-coded CGI scripts are known to not recognize this. Therefore (1,1) was
-selected as a safer default.
-
-=cut
-
-sub click
-{
- my $self = shift;
- my $name;
- $name = shift if (@_ % 2) == 1; # odd number of arguments
-
- # try to find first submit button to activate
- for (@{$self->{'inputs'}}) {
- next unless $_->can("click");
- next if $name && $_->name ne $name;
- next if $_->disabled;
- return $_->click($self, @_);
- }
- Carp::croak("No clickable input with name $name") if $name;
- $self->make_request;
-}
-
-
-=item @kw = $form->form
-
-Returns the current setting as a sequence of key/value pairs. Note
-that keys might be repeated, which means that some values might be
-lost if the return values are assigned to a hash.
-
-In scalar context this method returns the number of key/value pairs
-generated.
-
-=cut
-
-sub form
-{
- my $self = shift;
- map { $_->form_name_value($self) } @{$self->{'inputs'}};
-}
-
-
-=item $form->dump
-
-Returns a textual representation of current state of the form. Mainly
-useful for debugging. If called in void context, then the dump is
-printed on STDERR.
-
-=cut
-
-sub dump
-{
- my $self = shift;
- my $method = $self->{'method'};
- my $uri = $self->{'action'};
- my $enctype = $self->{'enctype'};
- my $dump = "$method $uri";
- $dump .= " ($enctype)"
- if $enctype ne "application/x-www-form-urlencoded";
- $dump .= " [$self->{attr}{name}]"
- if exists $self->{attr}{name};
- $dump .= "\n";
- for ($self->inputs) {
- $dump .= " " . $_->dump . "\n";
- }
- print STDERR $dump unless defined wantarray;
- $dump;
-}
-
-
-#---------------------------------------------------
-package HTML::Form::Input;
-
-=back
-
-=head1 INPUTS
-
-An C<HTML::Form> objects contains a sequence of I<inputs>. References to
-the inputs can be obtained with the $form->inputs or $form->find_input
-methods.
-
-Note that there is I<not> a one-to-one correspondence between input
-I<objects> and E<lt>inputE<gt> I<elements> in the HTML document. An
-input object basically represents a name/value pair, so when multiple
-HTML elements contribute to the same name/value pair in the submitted
-form they are combined.
-
-The input elements that are mapped one-to-one are "text", "textarea",
-"password", "hidden", "file", "image", "submit" and "checkbox". For
-the "radio" and "option" inputs the story is not as simple: All
-E<lt>input type="radio"E<gt> elements with the same name will
-contribute to the same input radio object. The number of radio input
-objects will be the same as the number of distinct names used for the
-E<lt>input type="radio"E<gt> elements. For a E<lt>selectE<gt> element
-without the C<multiple> attribute there will be one input object of
-type of "option". For a E<lt>select multipleE<gt> element there will
-be one input object for each contained E<lt>optionE<gt> element. Each
-one of these option objects will have the same name.
-
-The following methods are available for the I<input> objects:
-
-=over 4
-
-=cut
-
-sub new
-{
- my $class = shift;
- my $self = bless {@_}, $class;
- $self;
-}
-
-sub add_to_form
-{
- my($self, $form) = @_;
- push(@{$form->{'inputs'}}, $self);
- $self;
-}
-
-sub fixup {}
-
-
-=item $input->type
-
-Returns the type of this input. The type is one of the following
-strings: "text", "password", "hidden", "textarea", "file", "image", "submit",
-"radio", "checkbox" or "option".
-
-=cut
-
-sub type
-{
- shift->{type};
-}
-
-=item $name = $input->name
-
-=item $input->name( $new_name )
-
-This method can be used to get/set the current name of the input.
-
-=item $value = $input->value
-
-=item $input->value( $new_value )
-
-This method can be used to get/set the current value of an
-input.
-
-If the input only can take an enumerated list of values, then it is an
-error to try to set it to something else and the method will croak if
-you try.
-
-You will also be able to set the value of read-only inputs, but a
-warning will be generated if running under C<perl -w>.
-
-=cut
-
-sub name
-{
- my $self = shift;
- my $old = $self->{name};
- $self->{name} = shift if @_;
- $old;
-}
-
-sub value
-{
- my $self = shift;
- my $old = $self->{value};
- $self->{value} = shift if @_;
- $old;
-}
-
-=item $input->possible_values
-
-Returns a list of all values that an input can take. For inputs that
-do not have discrete values, this returns an empty list.
-
-=cut
-
-sub possible_values
-{
- return;
-}
-
-=item $input->other_possible_values
-
-Returns a list of all values not tried yet.
-
-=cut
-
-sub other_possible_values
-{
- return;
-}
-
-=item $input->value_names
-
-For some inputs the values can have names that are different from the
-values themselves. The number of names returned by this method will
-match the number of values reported by $input->possible_values.
-
-When setting values using the value() method it is also possible to
-use the value names in place of the value itself.
-
-=cut
-
-sub value_names {
- return
-}
-
-=item $bool = $input->readonly
-
-=item $input->readonly( $bool )
-
-This method is used to get/set the value of the readonly attribute.
-You are allowed to modify the value of readonly inputs, but setting
-the value will generate some noise when warnings are enabled. Hidden
-fields always start out readonly.
-
-=cut
-
-sub readonly {
- my $self = shift;
- my $old = $self->{readonly};
- $self->{readonly} = shift if @_;
- $old;
-}
-
-=item $bool = $input->disabled
-
-=item $input->disabled( $bool )
-
-This method is used to get/set the value of the disabled attribute.
-Disabled inputs do not contribute any key/value pairs for the form
-value.
-
-=cut
-
-sub disabled {
- my $self = shift;
- my $old = $self->{disabled};
- $self->{disabled} = shift if @_;
- $old;
-}
-
-=item $input->form_name_value
-
-Returns a (possible empty) list of key/value pairs that should be
-incorporated in the form value from this input.
-
-=cut
-
-sub form_name_value
-{
- my $self = shift;
- my $name = $self->{'name'};
- return unless defined $name;
- return if $self->disabled;
- my $value = $self->value;
- return unless defined $value;
- return ($name => $value);
-}
-
-sub dump
-{
- my $self = shift;
- my $name = $self->name;
- $name = "<NONAME>" unless defined $name;
- my $value = $self->value;
- $value = "<UNDEF>" unless defined $value;
- my $dump = "$name=$value";
-
- my $type = $self->type;
-
- $type .= " disabled" if $self->disabled;
- $type .= " readonly" if $self->readonly;
- return sprintf "%-30s %s", $dump, "($type)" unless $self->{menu};
-
- my @menu;
- my $i = 0;
- for (@{$self->{menu}}) {
- my $opt = $_->{value};
- $opt = "<UNDEF>" unless defined $opt;
- $opt .= "/$_->{name}"
- if defined $_->{name} && length $_->{name} && $_->{name} ne $opt;
- substr($opt,0,0) = "-" if $_->{disabled};
- if (exists $self->{current} && $self->{current} == $i) {
- substr($opt,0,0) = "!" unless $_->{seen};
- substr($opt,0,0) = "*";
- }
- else {
- substr($opt,0,0) = ":" if $_->{seen};
- }
- push(@menu, $opt);
- $i++;
- }
-
- return sprintf "%-30s %-10s %s", $dump, "($type)", "[" . join("|", @menu) . "]";
-}
-
-
-#---------------------------------------------------
-package HTML::Form::TextInput;
-@HTML::Form::TextInput::ISA=qw(HTML::Form::Input);
-
-#input/text
-#input/password
-#input/hidden
-#textarea
-
-sub value
-{
- my $self = shift;
- my $old = $self->{value};
- $old = "" unless defined $old;
- if (@_) {
- Carp::carp("Input '$self->{name}' is readonly")
- if $^W && $self->{readonly};
- my $new = shift;
- my $n = exists $self->{maxlength} ? $self->{maxlength} : undef;
- Carp::carp("Input '$self->{name}' has maxlength '$n'")
- if $^W && defined($n) && defined($new) && length($new) > $n;
- $self->{value} = $new;
- }
- $old;
-}
-
-#---------------------------------------------------
-package HTML::Form::IgnoreInput;
-@HTML::Form::IgnoreInput::ISA=qw(HTML::Form::Input);
-
-#input/button
-#input/reset
-
-sub value { return }
-
-
-#---------------------------------------------------
-package HTML::Form::ListInput;
-@HTML::Form::ListInput::ISA=qw(HTML::Form::Input);
-
-#select/option (val1, val2, ....)
-#input/radio (undef, val1, val2,...)
-#input/checkbox (undef, value)
-#select-multiple/option (undef, value)
-
-sub new
-{
- my $class = shift;
- my $self = $class->SUPER::new(@_);
-
- my $value = delete $self->{value};
- my $value_name = delete $self->{value_name};
- my $type = $self->{type};
-
- if ($type eq "checkbox") {
- $value = "on" unless defined $value;
- $self->{menu} = [
- { value => undef, name => "off", },
- { value => $value, name => $value_name, },
- ];
- $self->{current} = (delete $self->{checked}) ? 1 : 0;
- ;
- }
- else {
- $self->{option_disabled}++
- if $type eq "radio" && delete $self->{disabled};
- $self->{menu} = [
- {value => $value, name => $value_name},
- ];
- my $checked = $self->{checked} || $self->{option_selected};
- delete $self->{checked};
- delete $self->{option_selected};
- if (exists $self->{multiple}) {
- unshift(@{$self->{menu}}, { value => undef, name => "off"});
- $self->{current} = $checked ? 1 : 0;
- }
- else {
- $self->{current} = 0 if $checked;
- }
- }
- $self;
-}
-
-sub add_to_form
-{
- my($self, $form) = @_;
- my $type = $self->type;
-
- return $self->SUPER::add_to_form($form)
- if $type eq "checkbox";
-
- if ($type eq "option" && exists $self->{multiple}) {
- $self->{disabled} ||= delete $self->{option_disabled};
- return $self->SUPER::add_to_form($form);
- }
-
- die "Assert" if @{$self->{menu}} != 1;
- my $m = $self->{menu}[0];
- $m->{disabled}++ if delete $self->{option_disabled};
-
- my $prev = $form->find_input($self->{name}, $self->{type}, $self->{idx});
- return $self->SUPER::add_to_form($form) unless $prev;
-
- # merge menues
- $prev->{current} = @{$prev->{menu}} if exists $self->{current};
- push(@{$prev->{menu}}, $m);
-}
-
-sub fixup
-{
- my $self = shift;
- if ($self->{type} eq "option" && !(exists $self->{current})) {
- $self->{current} = 0;
- }
- $self->{menu}[$self->{current}]{seen}++ if exists $self->{current};
-}
-
-sub disabled
-{
- my $self = shift;
- my $type = $self->type;
-
- my $old = $self->{disabled} || _menu_all_disabled(@{$self->{menu}});
- if (@_) {
- my $v = shift;
- $self->{disabled} = $v;
- for (@{$self->{menu}}) {
- $_->{disabled} = $v;
- }
- }
- return $old;
-}
-
-sub _menu_all_disabled {
- for (@_) {
- return 0 unless $_->{disabled};
- }
- return 1;
-}
-
-sub value
-{
- my $self = shift;
- my $old;
- $old = $self->{menu}[$self->{current}]{value} if exists $self->{current};
- if (@_) {
- my $i = 0;
- my $val = shift;
- my $cur;
- my $disabled;
- for (@{$self->{menu}}) {
- if ((defined($val) && defined($_->{value}) && $val eq $_->{value}) ||
- (!defined($val) && !defined($_->{value}))
- )
- {
- $cur = $i;
- $disabled = $_->{disabled};
- last unless $disabled;
- }
- $i++;
- }
- if (!(defined $cur) || $disabled) {
- if (defined $val) {
- # try to search among the alternative names as well
- my $i = 0;
- my $cur_ignorecase;
- my $lc_val = lc($val);
- for (@{$self->{menu}}) {
- if (defined $_->{name}) {
- if ($val eq $_->{name}) {
- $disabled = $_->{disabled};
- $cur = $i;
- last unless $disabled;
- }
- if (!defined($cur_ignorecase) && $lc_val eq lc($_->{name})) {
- $cur_ignorecase = $i;
- }
- }
- $i++;
- }
- unless (defined $cur) {
- $cur = $cur_ignorecase;
- if (defined $cur) {
- $disabled = $self->{menu}[$cur]{disabled};
- }
- else {
- my $n = $self->name;
- Carp::croak("Illegal value '$val' for field '$n'");
- }
- }
- }
- else {
- my $n = $self->name;
- Carp::croak("The '$n' field can't be unchecked");
- }
- }
- if ($disabled) {
- my $n = $self->name;
- Carp::croak("The value '$val' has been disabled for field '$n'");
- }
- $self->{current} = $cur;
- $self->{menu}[$cur]{seen}++;
- }
- $old;
-}
-
-=item $input->check
-
-Some input types represent toggles that can be turned on/off. This
-includes "checkbox" and "option" inputs. Calling this method turns
-this input on without having to know the value name. If the input is
-already on, then nothing happens.
-
-This has the same effect as:
-
- $input->value($input->possible_values[1]);
-
-The input can be turned off with:
-
- $input->value(undef);
-
-=cut
-
-sub check
-{
- my $self = shift;
- $self->{current} = 1;
- $self->{menu}[1]{seen}++;
-}
-
-sub possible_values
-{
- my $self = shift;
- map $_->{value}, @{$self->{menu}};
-}
-
-sub other_possible_values
-{
- my $self = shift;
- map $_->{value}, grep !$_->{seen}, @{$self->{menu}};
-}
-
-sub value_names {
- my $self = shift;
- my @names;
- for (@{$self->{menu}}) {
- my $n = $_->{name};
- $n = $_->{value} unless defined $n;
- push(@names, $n);
- }
- @names;
-}
-
-
-#---------------------------------------------------
-package HTML::Form::SubmitInput;
-@HTML::Form::SubmitInput::ISA=qw(HTML::Form::Input);
-
-#input/image
-#input/submit
-
-=item $input->click($form, $x, $y)
-
-Some input types (currently "submit" buttons and "images") can be
-clicked to submit the form. The click() method returns the
-corresponding C<HTTP::Request> object.
-
-=cut
-
-sub click
-{
- my($self,$form,$x,$y) = @_;
- for ($x, $y) { $_ = 1 unless defined; }
- local($self->{clicked}) = [$x,$y];
- return $form->make_request;
-}
-
-sub form_name_value
-{
- my $self = shift;
- return unless $self->{clicked};
- return $self->SUPER::form_name_value(@_);
-}
-
-
-#---------------------------------------------------
-package HTML::Form::ImageInput;
-@HTML::Form::ImageInput::ISA=qw(HTML::Form::SubmitInput);
-
-sub form_name_value
-{
- my $self = shift;
- my $clicked = $self->{clicked};
- return unless $clicked;
- return if $self->{disabled};
- my $name = $self->{name};
- $name = (defined($name) && length($name)) ? "$name." : "";
- return ("${name}x" => $clicked->[0],
- "${name}y" => $clicked->[1]
- );
-}
-
-#---------------------------------------------------
-package HTML::Form::FileInput;
-@HTML::Form::FileInput::ISA=qw(HTML::Form::TextInput);
-
-=back
-
-If the input is of type C<file>, then it has these additional methods:
-
-=over 4
-
-=item $input->file
-
-This is just an alias for the value() method. It sets the filename to
-read data from.
-
-=cut
-
-sub file {
- my $self = shift;
- $self->value(@_);
-}
-
-=item $filename = $input->filename
-
-=item $input->filename( $new_filename )
-
-This get/sets the filename reported to the server during file upload.
-This attribute defaults to the value reported by the file() method.
-
-=cut
-
-sub filename {
- my $self = shift;
- my $old = $self->{filename};
- $self->{filename} = shift if @_;
- $old = $self->file unless defined $old;
- $old;
-}
-
-=item $content = $input->content
-
-=item $input->content( $new_content )
-
-This get/sets the file content provided to the server during file
-upload. This method can be used if you do not want the content to be
-read from an actual file.
-
-=cut
-
-sub content {
- my $self = shift;
- my $old = $self->{content};
- $self->{content} = shift if @_;
- $old;
-}
-
-=item @headers = $input->headers
-
-=item input->headers($key => $value, .... )
-
-This get/set additional header fields describing the file uploaded.
-This can for instance be used to set the C<Content-Type> reported for
-the file.
-
-=cut
-
-sub headers {
- my $self = shift;
- my $old = $self->{headers} || [];
- $self->{headers} = [@_] if @_;
- @$old;
-}
-
-sub form_name_value {
- my($self, $form) = @_;
- return $self->SUPER::form_name_value($form)
- if $form->method ne "POST" ||
- $form->enctype ne "multipart/form-data";
-
- my $name = $self->name;
- return unless defined $name;
- return if $self->{disabled};
-
- my $file = $self->file;
- my $filename = $self->filename;
- my @headers = $self->headers;
- my $content = $self->content;
- if (defined $content) {
- $filename = $file unless defined $filename;
- $file = undef;
- unshift(@headers, "Content" => $content);
- }
- elsif (!defined($file) || length($file) == 0) {
- return;
- }
-
- # legacy (this used to be the way to do it)
- if (ref($file) eq "ARRAY") {
- my $f = shift @$file;
- my $fn = shift @$file;
- push(@headers, @$file);
- $file = $f;
- $filename = $fn unless defined $filename;
- }
-
- return ($name => [$file, $filename, @headers]);
-}
-
-package HTML::Form::KeygenInput;
-@HTML::Form::KeygenInput::ISA=qw(HTML::Form::Input);
-
-sub challenge {
- my $self = shift;
- return $self->{challenge};
-}
-
-sub keytype {
- my $self = shift;
- return lc($self->{keytype} || 'rsa');
-}
-
-1;
-
-__END__
-
-=back
-
-=head1 SEE ALSO
-
-L<LWP>, L<LWP::UserAgent>, 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/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/HTML/Tagset.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/HTML/Tagset.pm
deleted file mode 100644
index 754137fd6fe..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/HTML/Tagset.pm
+++ /dev/null
@@ -1,471 +0,0 @@
-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/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/HTTP/Cookies.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/HTTP/Cookies.pm
deleted file mode 100644
index 7abc4b2a01f..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/HTTP/Cookies.pm
+++ /dev/null
@@ -1,775 +0,0 @@
-package HTTP::Cookies;
-
-use strict;
-use HTTP::Date qw(str2time time2str);
-use HTTP::Headers::Util qw(split_header_words join_header_words);
-use LWP::Debug ();
-
-use vars qw($VERSION $EPOCH_OFFSET);
-$VERSION = "5.810";
-
-# 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->url;
- my $scheme = $url->scheme;
- unless ($scheme =~ /^https?\z/) {
- LWP::Debug::debug("Will not add cookies to non-HTTP requests");
- 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 =~ /\./) {
-
- LWP::Debug::debug("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) {
- LWP::Debug::debug("- checking cookie path=$path");
- if (index($req_path, $path) != 0) {
- LWP::Debug::debug(" path $path:$req_path does not fit");
- next;
- }
-
- my($key,$array);
- while (($key,$array) = each %{$cookies->{$path}}) {
- my($version,$val,$port,$path_spec,$secure,$expires) = @$array;
- LWP::Debug::debug(" - checking cookie $key=$val");
- if ($secure && !$secure_request) {
- LWP::Debug::debug(" not a secure requests");
- next;
- }
- if ($expires && $expires < $now) {
- LWP::Debug::debug(" expired");
- next;
- }
- if ($port) {
- my $found;
- if ($port =~ s/^_//) {
- # The correponding 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) {
- LWP::Debug::debug(" port $port:$req_port does not fit");
- next;
- }
- }
- if ($version > 0 && $netscape_only) {
- LWP::Debug::debug(" domain $domain applies to " .
- "Netscape-style cookies only");
- next;
- }
-
- LWP::Debug::debug(" it's a match");
-
- # 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;
- }
- }
-
- $request->header(Cookie => join("; ", @cval)) if @cval;
-
- $request;
-}
-
-
-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->url;
- 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://wp.netscape.com/newsref/std/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) {
- my @cur;
- my $param;
- my $expires;
- my $first_param = 1;
- for $param (split(/;\s*/, $set)) {
- 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 ($etime) {
- push(@cur, "Max-Age" => str2time($v) - $now);
- $expires++;
- }
- }
- 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;
-
- LWP::Debug::debug("Set cookie $key => $val");
-
- 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 signigicant
- $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") {
- LWP::Debug::debug("Domain $domain contains no dot");
- next SET_COOKIE;
- }
- $domain = ".$domain" unless $domain =~ /^\./;
- if ($domain =~ /\.\d+$/) {
- LWP::Debug::debug("IP-address $domain illeagal as domain");
- next SET_COOKIE;
- }
- my $len = length($domain);
- unless (substr($req_host, -$len) eq $domain) {
- LWP::Debug::debug("Domain $domain does not match host $req_host");
- next SET_COOKIE;
- }
- my $hostpre = substr($req_host, 0, length($req_host) - $len);
- if ($hostpre =~ /\./ && !$ns_cookie) {
- LWP::Debug::debug("Host prefix contain a dot: $hostpre => $domain");
- 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) {
- LWP::Debug::debug("Path $path is not a prefix of $req_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+$/) {
- LWP::Debug::debug("Bad port $port (not numeric)");
- next SET_COOKIE;
- }
- $found++ if $p eq $req_port;
- }
- unless ($found) {
- LWP::Debug::debug("Request port ($req_port) not found in $port");
- 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;
- local(*FILE);
- open(FILE, ">$file") or die "Can't open $file: $!";
- print FILE "#LWP-Cookies-1.0\n";
- print FILE $self->as_string(!$self->{ignore_discard});
- close(FILE);
- 1;
-}
-
-
-sub load
-{
- my $self = shift;
- my $file = shift || $self->{'file'} || return;
- local(*FILE, $_);
- local $/ = "\n"; # make sure we got standard record separator
- open(FILE, $file) or return;
- my $magic = <FILE>;
- unless ($magic =~ /^\#LWP-Cookies-(\d+\.\d+)/) {
- warn "$file does not seem to contain cookies";
- return;
- }
- while (<FILE>) {
- next unless s/^Set-Cookie3:\s*//;
- chomp;
- my $cookie;
- for $cookie (split_header_words($_)) {
- 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;
- }
- }
- close(FILE);
- 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;
- $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;
-
-__END__
-
-=head1 NAME
-
-HTTP::Cookies - HTTP cookie jars
-
-=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://wp.netscape.com/newsref/std/cookie_spec.html> and
-<URL:http://www.cookiecentral.com/>. This module also implements the
-new style cookies described in I<RFC 2965>.
-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 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->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 <= 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 COPYRIGHT
-
-Copyright 1997-2002 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/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/HTTP/Cookies/Microsoft.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/HTTP/Cookies/Microsoft.pm
deleted file mode 100644
index 0c2614cd0b2..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/HTTP/Cookies/Microsoft.pm
+++ /dev/null
@@ -1,328 +0,0 @@
-package HTTP::Cookies::Microsoft;
-
-use strict;
-
-use vars qw(@ISA $VERSION);
-
-$VERSION = "5.810";
-
-require HTTP::Cookies;
-@ISA=qw(HTTP::Cookies);
-
-sub load_cookies_from_file
-{
- my ($file) = @_;
- my @cookies;
- my ($key, $value, $domain_path, $flags, $lo_expire, $hi_expire);
- my ($lo_create, $hi_create, $sep);
-
- open(COOKIES, $file) || return;
-
- while ($key = <COOKIES>)
- {
- chomp($key);
- chomp($value = <COOKIES>);
- chomp($domain_path= <COOKIES>);
- chomp($flags = <COOKIES>); # 0x0001 bit is for secure
- chomp($lo_expire = <COOKIES>);
- chomp($hi_expire = <COOKIES>);
- chomp($lo_create = <COOKIES>);
- chomp($hi_create = <COOKIES>);
- chomp($sep = <COOKIES>);
-
- 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 = $` . "\\";
- }
-
- local(*INDEX, $_);
-
- open(INDEX, $cookie_index) || return;
- binmode(INDEX);
- if (256 != read(INDEX, $data, 256))
- {
- warn "$cookie_index file is not large enough";
- close(INDEX);
- 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);
-
- if (($sig !~ /^Client UrlCache MMF Ver 5\.2/) || # check that sig is valid (only tested in IE6.0)
- (0x4000 != $size))
- {
- warn "$cookie_index ['$sig' $size] does not seem to contain cookies";
- close(INDEX);
- return;
- }
-
- if (0 == seek(INDEX, $size, 0)) # move the file ptr to start of the first record
- {
- close(INDEX);
- 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(INDEX, $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(INDEX, ($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(INDEX, $data, $more_data, 256))
- {
- last;
- }
- }
-
- if ($data =~ /Cookie\:$user_name\@([\x21-\xFF]+).*?($user_name\@[\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);
- }
- }
- }
-
- close(INDEX);
-
- 1;
-}
-
-1;
-
-__END__
-
-=head1 NAME
-
-HTTP::Cookies::Microsoft - access to Microsoft cookies files
-
-=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.
-
-=cut
-
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/HTTP/Cookies/Netscape.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/HTTP/Cookies/Netscape.pm
deleted file mode 100644
index a086ffdb466..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/HTTP/Cookies/Netscape.pm
+++ /dev/null
@@ -1,116 +0,0 @@
-package HTTP::Cookies::Netscape;
-
-use strict;
-use vars qw(@ISA $VERSION);
-
-$VERSION = "5.810";
-
-require HTTP::Cookies;
-@ISA=qw(HTTP::Cookies);
-
-sub load
-{
- my($self, $file) = @_;
- $file ||= $self->{'file'} || return;
- local(*FILE, $_);
- local $/ = "\n"; # make sure we got standard record separator
- my @cookies;
- open(FILE, $file) || return;
- my $magic = <FILE>;
- unless ($magic =~ /^\#(?: Netscape)? HTTP Cookie File/) {
- warn "$file does not look like a netscape cookies file" if $^W;
- LWP::Debug::debug("$file doesn't look like a netscape cookies file. Skipping.");
- close(FILE);
- return;
- }
- LWP::Debug::debug("Okay, $file is a netscape cookies file. Parsing.");
- my $now = time() - $HTTP::Cookies::EPOCH_OFFSET;
- while (<FILE>) {
- next if /^\s*\#/;
- next if /^\s*$/;
- tr/\n\r//d;
- my($domain,$bool1,$path,$secure, $expires,$key,$val) = split(/\t/, $_);
- LWP::Debug::debug(join '', "-Reading NS cookie: ",
- map(" <$_>", split(/\t/, $_)));
- $secure = ($secure eq "TRUE");
- $self->set_cookie(undef,$key,$val,$path,$domain,undef,
- 0,$secure,$expires-$now, 0);
- }
- close(FILE);
- 1;
-}
-
-sub save
-{
- my($self, $file) = @_;
- $file ||= $self->{'file'} || return;
- local(*FILE, $_);
- open(FILE, ">$file") || return;
-
- print FILE <<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 FILE join("\t", $domain, $bool, $path, $secure, $expires, $key, $val), "\n";
- });
- close(FILE);
- 1;
-}
-
-1;
-__END__
-
-=head1 NAME
-
-HTTP::Cookies::Netscape - access to Netscape cookies files
-
-=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 COPYRIGHT
-
-Copyright 2002-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/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/HTTP/Daemon.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/HTTP/Daemon.pm
deleted file mode 100644
index 4180e834c5e..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/HTTP/Daemon.pm
+++ /dev/null
@@ -1,885 +0,0 @@
-package HTTP::Daemon;
-
-use strict;
-use vars qw($VERSION @ISA $PROTO $DEBUG);
-
-$VERSION = "5.810";
-
-use IO::Socket qw(AF_INET INADDR_ANY 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();
- }
- 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);
- }
- 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 ($ct && lc($ct) =~ m/^multipart\/\w+\s*;.*boundary\s*=\s*(\w+)/) {
- # Handle multipart content type
- my $boundary = "$CRLF--$1--$CRLF";
- 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) = '';
-
- }
- 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='';
- }
- }
- ${*$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_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->url->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 read 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 return 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_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/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/HTTP/Date.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/HTTP/Date.pm
deleted file mode 100644
index aaafbda01a9..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/HTTP/Date.pm
+++ /dev/null
@@ -1,389 +0,0 @@
-package HTTP::Date;
-
-$VERSION = "5.810";
-
-require 5.004;
-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+\))? # ASCII representation of timezone in parens.
- \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, 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
-returned will B<not> have the number 1900 subtracted from it and the
-$month numbers start with 1.
-
-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.
-
-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/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/HTTP/Headers.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/HTTP/Headers.pm
deleted file mode 100644
index 7cb5fe11f68..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/HTTP/Headers.pm
+++ /dev/null
@@ -1,737 +0,0 @@
-package HTTP::Headers;
-
-use strict;
-use Carp ();
-
-use vars qw($VERSION $TRANSLATE_UNDERSCORE);
-$VERSION = "5.810";
-
-# The $TRANSLATE_UNDERSCORE variable controls whether '_' can be used
-# as a replacement for '-' in header field names.
-$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
-{
- Carp::croak('Usage: $h->push_header($field, $val)') if @_ != 3;
- shift->_header(@_, 'PUSH');
-}
-
-
-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};
- }
- $c;
-}
-
-
-sub _header
-{
- my($self, $field, $val, $op) = @_;
-
- # $push is only used interally sub push_header
- Carp::croak('Need a field name') unless length($field);
-
- unless ($field =~ /^:/) {
- $field =~ tr/_/-/ if $TRANSLATE_UNDERSCORE;
- my $old = $field;
- $field = lc $field;
- unless(defined $standard_case{$field}) {
- # generate a %standard_case entry for this field
- $old =~ s/\b(\w)/\u$1/g;
- $standard_case{$field} = $old;
- }
- }
-
- my $h = $self->{$field};
- my @old = ref($h) eq 'ARRAY' ? @$h : (defined($h) ? ($h) : ());
-
- $op ||= defined($val) ? 'SET' : 'GET';
- 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
- } keys %$self
-}
-
-
-sub header_field_names {
- my $self = shift;
- return map $standard_case{$_} || $_, $self->_sorted_field_names
- if wantarray;
- return keys %$self;
-}
-
-
-sub scan
-{
- my($self, $sub) = @_;
- my $key;
- foreach $key ($self->_sorted_field_names) {
- next if $key =~ /^_/;
- my $vals = $self->{$key};
- if (ref($vals) eq 'ARRAY') {
- my $val;
- for $val (@$vals) {
- &$sub($standard_case{$key} || $key, $val);
- }
- }
- else {
- &$sub($standard_case{$key} || $key, $vals);
- }
- }
-}
-
-
-sub as_string
-{
- my($self, $endl) = @_;
- $endl = "\n" unless defined $endl;
-
- my @result = ();
- $self->scan(sub {
- my($field, $val) = @_;
- $field =~ s/^://;
- if ($val =~ /\n/) {
- # must handle header values with embedded newlines with care
- $val =~ s/\s+$//; # trailing newlines and space must go
- $val =~ s/\n\n+/\n/g; # no empty lines
- $val =~ s/\n([^\040\t])/\n $1/g; # intial space for continuation
- $val =~ s/\n/$endl/g; # substitute with requested line ending
- }
- push(@result, "$field: $val");
- });
-
- join($endl, @result, '');
-}
-
-
-sub clone
-{
- my $self = shift;
- my $clone = new HTTP::Headers;
- $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 $ct = (shift->_header('Content-Type', @_))[0];
- return '' unless defined($ct) && length($ct);
- my @ct = split(/;\s*/, $ct, 2);
- for ($ct[0]) {
- s/\s+//g;
- $_ = lc($_);
- }
- wantarray ? @ct : $ct[0];
-}
-
-sub _is_html {
- my $self = shift;
- return $self->content_type eq 'text/html' || $self->_is_xhtml;
-}
-
-sub _is_xhtml {
- my $ct = shift->content_type;
- for (qw(application/xhtml+xml application/vnd.wap.xhtml+xml)) {
- return 1 if $_ eq $ct;
- }
- 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;
-
-__END__
-
-=head1 NAME
-
-HTTP::Headers - Class encapsulating HTTP Message headers
-
-=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, ... )
-
-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) promise 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 )
-
-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-> falls
-into this category, as well as C<Allow>, C<Expires> and
-C<Last-Modified>. RFC 2616 denote 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->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. 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_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/1.2');
-
-=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 COPYRIGHT
-
-Copyright 1995-2005 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/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/HTTP/Headers/Auth.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/HTTP/Headers/Auth.pm
deleted file mode 100644
index 0d994c769ba..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/HTTP/Headers/Auth.pm
+++ /dev/null
@@ -1,98 +0,0 @@
-package HTTP::Headers::Auth;
-
-use strict;
-use vars qw($VERSION);
-$VERSION = "5.810";
-
-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, lc(shift @$_) => {});
- shift @$_;
- }
- if (@ret) {
- # this a new parameter pair for the last auth scheme
- while (@$_) {
- my $k = lc(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;
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/HTTP/Headers/ETag.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/HTTP/Headers/ETag.pm
deleted file mode 100644
index 743da463de4..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/HTTP/Headers/ETag.pm
+++ /dev/null
@@ -1,94 +0,0 @@
-package HTTP::Headers::ETag;
-
-use strict;
-use vars qw($VERSION);
-$VERSION = "5.810";
-
-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;
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/HTTP/Headers/Util.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/HTTP/Headers/Util.pm
deleted file mode 100644
index 3c3dfe00bb6..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/HTTP/Headers/Util.pm
+++ /dev/null
@@ -1,184 +0,0 @@
-package HTTP::Headers::Util;
-
-use strict;
-use vars qw($VERSION @ISA @EXPORT_OK);
-
-$VERSION = "5.810";
-
-require Exporter;
-@ISA=qw(Exporter);
-
-@EXPORT_OK=qw(split_header_words join_header_words);
-
-
-
-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;
-
-__END__
-
-=head1 NAME
-
-HTTP::Headers::Util - Header value parsing utility functions
-
-=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 value for a simple token (not part of a parameter) is C<undef>.
-Syntactically incorrect headers will not necessary 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\""]
-
-=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 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.
-
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/HTTP/Message.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/HTTP/Message.pm
deleted file mode 100644
index de03bd61239..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/HTTP/Message.pm
+++ /dev/null
@@ -1,762 +0,0 @@
-package HTTP::Message;
-
-use strict;
-use vars qw($VERSION $AUTOLOAD);
-$VERSION = "5.812";
-
-require HTTP::Headers;
-require Carp;
-
-my $CRLF = "\015\012"; # "\r\n" is not portable
-$HTTP::URI_CLASS ||= $ENV{PERL_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;
- }
- }
-
- 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 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}} = $_[1];
- }
- else {
- die "Can't set content to be a scalar reference" if ref($_[1]) eq "SCALAR";
- $self->{_content} = $_[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 decoded_content
-{
- my($self, %opt) = @_;
- my $content_ref;
- my $content_ref_iscopy;
-
- eval {
-
- require HTTP::Headers::Util;
- my($ct, %ct_param);
- if (my @ct = HTTP::Headers::Util::split_header_words($self->header("Content-Type"))) {
- ($ct, undef, %ct_param) = @{$ct[-1]};
- $ct = lc($ct);
-
- die "Can't decode multipart content" if $ct =~ m,^multipart/,;
- }
-
- $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 || $ce eq "identity";
- if ($ce eq "gzip" || $ce eq "x-gzip") {
- require Compress::Zlib;
- unless ($content_ref_iscopy) {
- # memGunzip is documented to destroy its buffer argument
- my $copy = $$content_ref;
- $content_ref = \$copy;
- $content_ref_iscopy++;
- }
- $content_ref = \Compress::Zlib::memGunzip($$content_ref);
- die "Can't gunzip content" unless defined $$content_ref;
- }
- elsif ($ce eq "x-bzip2") {
- require Compress::Bzip2;
- $content_ref = Compress::Bzip2::decompress($$content_ref);
- die "Can't bunzip content" unless defined $$content_ref;
- $content_ref_iscopy++;
- }
- elsif ($ce eq "deflate") {
- require Compress::Zlib;
- my $out = Compress::Zlib::uncompress($$content_ref);
- unless (defined $out) {
- # "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.
- unless ($content_ref_iscopy) {
- # the $i->inflate method is documented to destroy its
- # buffer argument
- my $copy = $$content_ref;
- $content_ref = \$copy;
- $content_ref_iscopy++;
- }
-
- my($i, $status) = Compress::Zlib::inflateInit(
- WindowBits => -Compress::Zlib::MAX_WBITS(),
- );
- my $OK = Compress::Zlib::Z_OK();
- die "Can't init inflate object" unless $i && $status == $OK;
- ($out, $status) = $i->inflate($content_ref);
- if ($status != Compress::Zlib::Z_STREAM_END()) {
- if ($status == $OK) {
- $self->push_header("Client-Warning" =>
- "Content might be truncated; incomplete deflate stream");
- }
- else {
- # something went bad, can't trust $out any more
- $out = undef;
- }
- }
- }
- die "Can't inflate content" unless defined $out;
- $content_ref = \$out;
- $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 ($ct && $ct =~ m,^text/,,) {
- my $charset = $opt{charset} || $ct_param{charset} || $opt{default_charset} || "ISO-8859-1";
- $charset = lc($charset);
- if ($charset ne "none") {
- require Encode;
- if (do{my $v = $Encode::VERSION; $v =~ s/_//g; $v} < 2.0901 &&
- !$content_ref_iscopy)
- {
- # LEAVE_SRC did not work before Encode-2.0901
- my $copy = $$content_ref;
- $content_ref = \$copy;
- $content_ref_iscopy++;
- }
- $content_ref = \Encode::decode($charset, $$content_ref,
- ($opt{charset_strict} ? Encode::FB_CROAK() : 0) | Encode::LEAVE_SRC());
- }
- }
- };
- if ($@) {
- Carp::croak($@) if $opt{raise_error};
- return undef;
- }
-
- return $opt{ref} ? $content_ref : $$content_ref;
-}
-
-
-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 headers { shift->{'_headers'}; }
-sub headers_as_string { shift->{'_headers'}->as_string(@_); }
-
-
-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 = HTTP::Message->new($self->remove_content_headers,
- $self->content(""));
- $self->content_type("multipart/mixed");
- $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 the the _headers object.
-sub AUTOLOAD
-{
- my $method = substr($AUTOLOAD, rindex($AUTOLOAD, '::')+2);
- return if $method eq "DESTROY";
-
- # We create the function here so that it will not need to be
- # autoloaded the next time.
- no strict 'refs';
- *$method = eval "sub { shift->{'_headers'}->$method(\@_) }";
- goto &$method;
-}
-
-
-# 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--\r?\n.*//s;
- if ($str =~ s/(^|.*?\r?\n)--\Q$b\E\r?\n//s) {
- $self->{_parts} = [map HTTP::Message->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} = [ HTTP::Message->parse($self->content) ];
- }
-
- $self->{_parts} ||= [];
-}
-
-
-# Create private _content attribute from current _parts
-sub _content {
- my $self = shift;
- my $ct = $self->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 (lc($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->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;
-
-
-__END__
-
-=head1 NAME
-
-HTTP::Message - HTTP style message (base class)
-
-=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.
-
-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->decoded_content( %options )
-
-Returns the content with any C<Content-Encoding> undone and 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 of "ISO-8859-1".
-
-=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->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
-are 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 an @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.
-
-=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 COPYRIGHT
-
-Copyright 1995-2004 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/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/HTTP/Negotiate.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/HTTP/Negotiate.pm
deleted file mode 100644
index d3f3bda53c3..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/HTTP/Negotiate.pm
+++ /dev/null
@@ -1,529 +0,0 @@
-package HTTP::Negotiate;
-
-$VERSION = "5.813";
-sub Version { $VERSION; }
-
-require 5.002;
-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 = new HTTP::Headers;
- $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/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/HTTP/Request.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/HTTP/Request.pm
deleted file mode 100644
index 0161ec128b3..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/HTTP/Request.pm
+++ /dev/null
@@ -1,210 +0,0 @@
-package HTTP::Request;
-
-require HTTP::Message;
-@ISA = qw(HTTP::Message);
-$VERSION = "5.811";
-
-use strict;
-
-
-
-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) = @_;
- my $request_line;
- if ($str =~ s/^(.*)\n//) {
- $request_line = $1;
- }
- else {
- $request_line = $str;
- $str = "";
- }
-
- my $self = $class->SUPER::parse($str);
- my($method, $uri, $protocol) = split(' ', $request_line);
- $self->method($method) if defined($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 = $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;
- }
- $old;
-}
-
-*url = \&uri; # legacy
-
-
-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(@_));
-}
-
-
-1;
-
-__END__
-
-=head1 NAME
-
-HTTP::Request - HTTP style request message
-
-=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" 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 parseable 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->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 SEE ALSO
-
-L<HTTP::Headers>, L<HTTP::Message>, L<HTTP::Request::Common>,
-L<HTTP::Response>
-
-=head1 COPYRIGHT
-
-Copyright 1995-2004 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/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/HTTP/Request/Common.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/HTTP/Request/Common.pm
deleted file mode 100644
index df59516b672..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/HTTP/Request/Common.pm
+++ /dev/null
@@ -1,493 +0,0 @@
-package HTTP::Request::Common;
-
-use strict;
-use vars qw(@EXPORT @EXPORT_OK $VERSION $DYNAMIC_FILE_UPLOAD);
-
-$DYNAMIC_FILE_UPLOAD ||= 0; # make it defined (don't know why)
-
-require Exporter;
-*import = \&Exporter::import;
-@EXPORT =qw(GET HEAD PUT POST);
-@EXPORT_OK = qw($DYNAMIC_FILE_UPLOAD);
-
-require HTTP::Request;
-use Carp();
-
-$VERSION = "5.811";
-
-my $CRLF = "\015\012"; # "\r\n" is not portable
-
-sub GET { _simple_req('GET', @_); }
-sub HEAD { _simple_req('HEAD', @_); }
-sub PUT { _simple_req('PUT' , @_); }
-
-sub POST
-{
- my $url = shift;
- my $req = HTTP::Request->new(POST => $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 (lc($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;
- }
- }
-
- $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);
- while (($k,$v) = splice(@_, 0, 2)) {
- if (lc($k) eq 'content') {
- $req->add_content($v);
- $req->header("Content-Length", length(${$req->content_ref}));
- }
- else {
- $req->push_header($k, $v);
- }
- }
- $req;
-}
-
-
-sub form_data # RFC1867
-{
- my($data, $boundary, $req) = @_;
- my @data = ref($data) eq "HASH" ? %$data : @$data; # copy
- my $fhparts;
- my @parts;
- my($k,$v);
- while (($k,$v) = splice(@data, 0, 2)) {
- if (!ref($v)) {
- $k =~ s/([\\\"])/\\$1/g; # escape quotes and backslashes
- 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) {
- require Symbol;
- my $fh = Symbol::gensym();
- open($fh, $file) or Carp::croak("Can't open file $file: $!");
- binmode($fh);
- if ($DYNAMIC_FILE_UPLOAD) {
- # will read file later
- $content = $fh;
- }
- 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;
- 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;
-
-__END__
-
-=head1 NAME
-
-HTTP::Request::Common - Construct common HTTP::Request objects
-
-=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]);
-
-=head1 DESCRIPTION
-
-This module provide 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. The
-following functions are provided:
-
-=over 4
-
-=item GET $url
-
-=item GET $url, Header => Value,...
-
-The GET() function returns an C<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 PUT() and POST()
-functions described below.
-
-The get(...) method of C<LWP::UserAgent> exists as a shortcut for
-$ua->request(GET ...).
-
-=item HEAD $url
-
-=item HEAD $url, Header => Value,...
-
-Like GET() but the method in the request is "HEAD".
-
-The head(...) method of "LWP::UserAgent" exists as a shortcut for
-$ua->request(HEAD ...).
-
-=item PUT $url
-
-=item PUT $url, Header => Value,...
-
-=item PUT $url, Header => Value,..., Content => $content
-
-Like GET() but the method in the request is "PUT".
-
-The content of the request can be specified using the "Content"
-pseudo-header. This 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.
-
-=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
-
-This works mostly like PUT() with "POST" as the method, but this
-function also takes a second optional array or hash reference
-parameter $form_ref. As for PUT() the content can also be specified
-directly using the "Content" pseudo-header, and you may also provide
-the $form_ref this way.
-
-The $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 a 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 a 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 $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 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 a 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 $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 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 Content-Length is calculated and the time that the last
-chunk is delivered, the subroutine will C<Croak>.
-
-The post(...) method of "LWP::UserAgent" exists as a shortcut for
-$ua->request(POST ...).
-
-=back
-
-=head1 SEE ALSO
-
-L<HTTP::Request>, L<LWP::UserAgent>
-
-
-=head1 COPYRIGHT
-
-Copyright 1997-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/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/HTTP/Response.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/HTTP/Response.pm
deleted file mode 100644
index 6e3f7681e06..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/HTTP/Response.pm
+++ /dev/null
@@ -1,559 +0,0 @@
-package HTTP::Response;
-
-require HTTP::Message;
-@ISA = qw(HTTP::Message);
-$VERSION = "5.813";
-
-use strict;
-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) = @_;
- my $status_line;
- if ($str =~ s/^(.*)\n//) {
- $status_line = $1;
- }
- else {
- $status_line = $str;
- $str = "";
- }
-
- my $self = $class->SUPER::parse($str);
- 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
- 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 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 encoding;
- # This is ugly use of non-public API, but is there
- # a better way to accomplish what we want (locally
- # as-is usable filename string)?
- my $locale_charset = encoding::_get_locale_encoding();
- Encode::from_to($encfile, $charset, $locale_charset);
- };
-
- $file = $encfile unless $@;
- }
- }
- }
- }
-
- my $uri;
- unless (defined($file) && length($file)) {
- 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
-{
- require HTTP::Status;
- 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 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 error_as_HTML
-{
- require HTML::Entities;
- my $self = shift;
- my $title = 'An Error Occurred';
- my $body = HTML::Entities::encode($self->status_line);
- return <<EOM;
-<html>
-<head><title>$title</title></head>
-<body>
-<h1>$title</h1>
-<p>$body</p>
-</body>
-</html>
-EOM
-}
-
-
-sub current_age
-{
- my $self = 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
- }
-
- my $request = $self->request;
- if ($request) {
- my $request_time = $request->date;
- if ($request_time) {
- # Add response_delay to age to get 'corrected_initial_age'
- $age += $response_time - $request_time;
- }
- }
- if ($response_time) {
- $age += time - $response_time;
- }
- return $age;
-}
-
-
-sub freshness_lifetime
-{
- my $self = shift;
-
- # First look for the Cache-Control: max-age=n header
- my @cc = $self->header('Cache-Control');
- if (@cc) {
- my $cc;
- for $cc (@cc) {
- my $cc_dir;
- for $cc_dir (split(/\s*,\s*/, $cc)) {
- if ($cc_dir =~ /max-age\s*=\s*(\d+)/i) {
- return $1;
- }
- }
- }
- }
-
- # Next possibility is to look at the "Expires" header
- my $date = $self->date || $self->client_date || time;
- my $expires = $self->expires;
- unless ($expires) {
- # Must apply heuristic expiration
- my $last_modified = $self->last_modified;
- if ($last_modified) {
- my $h_exp = ($date - $last_modified) * 0.10; # 10% since last-mod
- if ($h_exp < 60) {
- return 60; # minimum
- }
- elsif ($h_exp > 24 * 3600) {
- # Should give a warning if more than 24 hours according to
- # RFC 2616 section 13.2.4, but I don't know how to do it
- # from this function interface, so I just make this the
- # maximum value.
- return 24 * 3600;
- }
- return $h_exp;
- }
- else {
- return 3600; # 1 hour is fallback when all else fails
- }
- }
- return $expires - $date;
-}
-
-
-sub is_fresh
-{
- my $self = shift;
- $self->freshness_lifetime > $self->current_age;
-}
-
-
-sub fresh_until
-{
- my $self = shift;
- return $self->freshness_lifetime - $self->current_age + time;
-}
-
-1;
-
-
-__END__
-
-=head1 NAME
-
-HTTP::Response - HTTP style response message
-
-=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->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 meaning 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 a 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 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.
-
-=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. 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
-
-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->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
-
-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 a number representing the freshness lifetime in
-seconds.
-
-If the response does not contain an "Expires" or a "Cache-Control"
-header, then this function will apply some simple heuristic based on
-'Last-Modified' to determine a suitable lifetime.
-
-=item $r->is_fresh
-
-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 refetched or revalidated by the origin
-server.
-
-=item $r->fresh_until
-
-Returns the time when this entity is no longer fresh.
-
-=back
-
-=head1 SEE ALSO
-
-L<HTTP::Headers>, L<HTTP::Message>, L<HTTP::Status>, L<HTTP::Request>
-
-=head1 COPYRIGHT
-
-Copyright 1995-2004 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/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/HTTP/Status.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/HTTP/Status.pm
deleted file mode 100644
index 2c81dd84ec1..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/HTTP/Status.pm
+++ /dev/null
@@ -1,247 +0,0 @@
-package HTTP::Status;
-
-use strict;
-require 5.002; # because we use prototypes
-
-use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION);
-
-require Exporter;
-@ISA = qw(Exporter);
-@EXPORT = qw(is_info is_success is_redirect is_error status_message);
-@EXPORT_OK = qw(is_client_error is_server_error);
-$VERSION = "5.811";
-
-# Note also addition of mnemonics to @EXPORT below
-
-# Unmarked codes are from RFC 2616
-# See also: http://en.wikipedia.org/wiki/List_of_HTTP_status_codes
-
-my %StatusCode = (
- 100 => 'Continue',
- 101 => 'Switching Protocols',
- 102 => 'Processing', # RFC 2518 (WebDAV)
- 200 => 'OK',
- 201 => 'Created',
- 202 => 'Accepted',
- 203 => 'Non-Authoritative Information',
- 204 => 'No Content',
- 205 => 'Reset Content',
- 206 => 'Partial Content',
- 207 => 'Multi-Status', # RFC 2518 (WebDAV)
- 300 => 'Multiple Choices',
- 301 => 'Moved Permanently',
- 302 => 'Found',
- 303 => 'See Other',
- 304 => 'Not Modified',
- 305 => 'Use Proxy',
- 307 => 'Temporary Redirect',
- 400 => 'Bad Request',
- 401 => 'Unauthorized',
- 402 => 'Payment Required',
- 403 => 'Forbidden',
- 404 => 'Not Found',
- 405 => 'Method Not Allowed',
- 406 => 'Not Acceptable',
- 407 => 'Proxy Authentication Required',
- 408 => 'Request Timeout',
- 409 => 'Conflict',
- 410 => 'Gone',
- 411 => 'Length Required',
- 412 => 'Precondition Failed',
- 413 => 'Request Entity Too Large',
- 414 => 'Request-URI Too Large',
- 415 => 'Unsupported Media Type',
- 416 => 'Request Range Not Satisfiable',
- 417 => 'Expectation Failed',
- 422 => 'Unprocessable Entity', # RFC 2518 (WebDAV)
- 423 => 'Locked', # RFC 2518 (WebDAV)
- 424 => 'Failed Dependency', # RFC 2518 (WebDAV)
- 425 => 'No code', # WebDAV Advanced Collections
- 426 => 'Upgrade Required', # RFC 2817
- 449 => 'Retry with', # unofficial Microsoft
- 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
- 507 => 'Insufficient Storage', # RFC 2518 (WebDAV)
- 509 => 'Bandwidth Limit Exceeded', # unofficial
- 510 => 'Not Extended', # RFC 2774
-);
-
-my $mnemonicCode = '';
-my ($code, $message);
-while (($code, $message) = each %StatusCode) {
- # create mnemonic subroutines
- $message =~ tr/a-z \-/A-Z__/;
- $mnemonicCode .= "sub RC_$message () { $code }\t";
- # make them exportable
- $mnemonicCode .= "push(\@EXPORT, 'RC_$message');\n";
-}
-# warn $mnemonicCode; # for development
-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");
-
-
-sub status_message ($) { $StatusCode{$_[0]}; }
-
-sub is_info ($) { $_[0] >= 100 && $_[0] < 200; }
-sub is_success ($) { $_[0] >= 200 && $_[0] < 300; }
-sub is_redirect ($) { $_[0] >= 300 && $_[0] < 400; }
-sub is_error ($) { $_[0] >= 400 && $_[0] < 600; }
-sub is_client_error ($) { $_[0] >= 400 && $_[0] < 500; }
-sub is_server_error ($) { $_[0] >= 500 && $_[0] < 600; }
-
-1;
-
-
-__END__
-
-=head1 NAME
-
-HTTP::Status - HTTP Status code processing
-
-=head1 SYNOPSIS
-
- use HTTP::Status;
-
- if ($rc != RC_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 a 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:
-
- RC_CONTINUE (100)
- RC_SWITCHING_PROTOCOLS (101)
- RC_PROCESSING (102)
-
- RC_OK (200)
- RC_CREATED (201)
- RC_ACCEPTED (202)
- RC_NON_AUTHORITATIVE_INFORMATION (203)
- RC_NO_CONTENT (204)
- RC_RESET_CONTENT (205)
- RC_PARTIAL_CONTENT (206)
- RC_MULTI_STATUS (207)
-
- RC_MULTIPLE_CHOICES (300)
- RC_MOVED_PERMANENTLY (301)
- RC_FOUND (302)
- RC_SEE_OTHER (303)
- RC_NOT_MODIFIED (304)
- RC_USE_PROXY (305)
- RC_TEMPORARY_REDIRECT (307)
-
- RC_BAD_REQUEST (400)
- RC_UNAUTHORIZED (401)
- RC_PAYMENT_REQUIRED (402)
- RC_FORBIDDEN (403)
- RC_NOT_FOUND (404)
- RC_METHOD_NOT_ALLOWED (405)
- RC_NOT_ACCEPTABLE (406)
- RC_PROXY_AUTHENTICATION_REQUIRED (407)
- RC_REQUEST_TIMEOUT (408)
- RC_CONFLICT (409)
- RC_GONE (410)
- RC_LENGTH_REQUIRED (411)
- RC_PRECONDITION_FAILED (412)
- RC_REQUEST_ENTITY_TOO_LARGE (413)
- RC_REQUEST_URI_TOO_LARGE (414)
- RC_UNSUPPORTED_MEDIA_TYPE (415)
- RC_REQUEST_RANGE_NOT_SATISFIABLE (416)
- RC_EXPECTATION_FAILED (417)
- RC_UNPROCESSABLE_ENTITY (422)
- RC_LOCKED (423)
- RC_FAILED_DEPENDENCY (424)
- RC_NO_CODE (425)
- RC_UPGRADE_REQUIRED (426)
- RC_RETRY_WITH (449)
-
- RC_INTERNAL_SERVER_ERROR (500)
- RC_NOT_IMPLEMENTED (501)
- RC_BAD_GATEWAY (502)
- RC_SERVICE_UNAVAILABLE (503)
- RC_GATEWAY_TIMEOUT (504)
- RC_HTTP_VERSION_NOT_SUPPORTED (505)
- RC_VARIANT_ALSO_NEGOTIATES (506)
- RC_INSUFFICIENT_STORAGE (507)
- RC_BANDWIDTH_LIMIT_EXCEEDED (509)
- RC_NOT_EXTENDED (510)
-
-=head1 FUNCTIONS
-
-The following additional functions are provided. Most of them are
-exported by default.
-
-=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 unknown, 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
-return TRUE for both client error or a server error status codes.
-
-=item is_client_error( $code )
-
-Return TRUE if C<$code> is an 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 an 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.
-
-=back
-
-=head1 BUGS
-
-Wished @EXPORT_OK had been used instead of @EXPORT in the beginning.
-Now too much is exported by default.
-
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/IO/CaptureOutput.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/IO/CaptureOutput.pm
deleted file mode 100644
index 5c34b1ff707..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/IO/CaptureOutput.pm
+++ /dev/null
@@ -1,317 +0,0 @@
-# $Id: CaptureOutput.pm,v 1.3 2005/03/25 12:44:14 simonflack Exp $
-package IO::CaptureOutput;
-use strict;
-use vars qw/$VERSION @ISA @EXPORT_OK %EXPORT_TAGS/;
-use Exporter;
-@ISA = 'Exporter';
-@EXPORT_OK = qw/capture capture_exec qxx capture_exec_combined qxy/;
-%EXPORT_TAGS = (all => \@EXPORT_OK);
-$VERSION = '1.0801';
-
-sub capture (&@) { ## no critic
- my ($code, $output, $error, $output_file, $error_file) = @_;
-
- for ($output, $error) {
- $_ = \do { my $s; $s = ''} unless ref $_;
- $$_ = '' if $_ != \undef && !defined($$_);
- }
-
- # don't merge if both undef -- someone might still want to capture
- # them separately in temp files
- my $should_merge = defined $error && defined $output && $output == $error;
-
- my ($capture_out, $capture_err);
- if ( $output != \undef ) {
- $capture_out = IO::CaptureOutput::_proxy->new(
- 'STDOUT', $output, undef, $output_file
- );
- }
- if ( $error != \undef ) {
- my $capture_err = IO::CaptureOutput::_proxy->new(
- 'STDERR', $error, ($should_merge ? 'STDOUT' : undef), $error_file
- );
- }
- &$code();
-}
-
-sub capture_exec {
- my @args = @_;
- my ($output, $error);
- capture sub { system _shell_quote(@args) }, \$output, \$error;
- return wantarray ? ($output, $error) : $output;
-}
-
-*qxx = \&capture_exec;
-
-sub capture_exec_combined {
- my @args = @_;
- my $output;
- capture sub { system _shell_quote(@args) }, \$output, \$output;
- return $output;
-}
-
-*qxy = \&capture_exec_combined;
-
-# extra quoting required on Win32 systems
-*_shell_quote = ($^O =~ /MSWin32/) ? \&_shell_quote_win32 : sub {@_};
-sub _shell_quote_win32 {
- my @args;
- for (@_) {
- if (/[ \"]/) { # TODO: check if ^ requires escaping
- (my $escaped = $_) =~ s/([\"])/\\$1/g;
- push @args, '"' . $escaped . '"';
- next;
- }
- push @args, $_
- }
- return @args;
-}
-
-# Captures everything printed to a filehandle for the lifetime of the object
-# and then transfers it to a scalar reference
-package IO::CaptureOutput::_proxy;
-use File::Temp 'tempfile';
-use File::Basename qw/basename/;
-use Symbol qw/gensym qualify qualify_to_ref/;
-use Carp;
-
-sub _is_wperl { $^O eq 'MSWin32' && basename($^X) eq 'wperl.exe' }
-
-sub new {
- my $class = shift;
- my ($fh, $capture, $merge_fh, $capture_file) = @_;
- $fh = qualify($fh); # e.g. main::STDOUT
- my $fhref = qualify_to_ref($fh); # e.g. \*STDOUT
-
- # Duplicate the filehandle
- my $saved;
- {
- no strict 'refs'; ## no critic - needed for 5.005
- if ( defined fileno($fh) && ! _is_wperl() ) {
- $saved = gensym;
- open $saved, ">&$fh" or croak "Can't redirect <$fh> - $!";
- }
- }
-
- # Create replacement filehandle if not merging
- my ($newio, $newio_file);
- if ( ! $merge_fh ) {
- $newio = gensym;
- if ($capture_file) {
- $newio_file = $capture_file;
- } else {
- (undef, $newio_file) = tempfile;
- }
- open $newio, "+>$newio_file" or croak "Can't write temp file for $fh - $!";
- }
- else {
- $newio = qualify($merge_fh);
- }
-
- # Redirect (or merge)
- {
- no strict 'refs'; ## no critic -- needed for 5.005
- open $fhref, ">&".fileno($newio) or croak "Can't redirect $fh - $!";
- }
-
- bless [$$, $fh, $saved, $capture, $newio, $newio_file, $capture_file], $class;
-}
-
-sub DESTROY {
- my $self = shift;
-
- my ($pid, $fh, $saved) = @{$self}[0..2];
- return unless $pid eq $$; # only cleanup in the process that is capturing
-
- # restore the original filehandle
- my $fh_ref = Symbol::qualify_to_ref($fh);
- select((select ($fh_ref), $|=1)[0]);
- if (defined $saved) {
- open $fh_ref, ">&". fileno($saved) or croak "Can't restore $fh - $!";
- }
- else {
- close $fh_ref;
- }
-
- # transfer captured data to the scalar reference if we didn't merge
- my ($capture, $newio, $newio_file) = @{$self}[3..5];
- if ($newio_file) {
- # some versions of perl complain about reading from fd 1 or 2
- # which could happen if STDOUT and STDERR were closed when $newio
- # was opened, so we just squelch warnings here and continue
- local $^W;
- seek $newio, 0, 0;
- $$capture = do {local $/; <$newio>};
- close $newio;
- }
-
- # Cleanup
- return unless defined $newio_file && -e $newio_file;
- return if $self->[6]; # the "temp" file was explicitly named
- unlink $newio_file or carp "Couldn't remove temp file '$newio_file' - $!";
-}
-
-1;
-
-__END__
-
-=pod
-
-=begin wikidoc
-
-= NAME
-
-IO::CaptureOutput - capture STDOUT and STDERR from Perl code, subprocesses or XS
-
-= VERSION
-
-This documentation describes version %%VERSION%%.
-
-= SYNOPSIS
-
- use IO::CaptureOutput qw(capture capture_exec);
-
- my ($stdout, $stderr);
-
- sub noisy {
- warn "this sub prints to stdout and stderr!";
- print "arguments: @_";
- }
-
- capture { noisy(@args) } \$stdout, \$stderr;
-
- ($stdout, $stderr) = capture_exec( 'perl', '-e',
- 'print "Hello"; print STDERR "World!"');
-
-= DESCRIPTION
-
-This module provides routines for capturing STDOUT and STDERR from perl
-subroutines, forked system calls (e.g. {system()}, {fork()}) and from
-XS or C modules.
-
-= FUNCTIONS
-
-The following functions will be exported on demand.
-
-== capture()
-
- capture \&subroutine, \$stdout, \$stderr;
-
-Captures everything printed to {STDOUT} and {STDERR} for the duration of
-{&subroutine}. {$stdout} and {$stderr} are optional scalars that will contain
-{STDOUT} and {STDERR} respectively.
-
-{capture()} uses a code prototype so the first argument can be specified directly within
-brackets if desired.
-
- # shorthand with prototype
- capture { print __PACKAGE__ } \$stdout, \$stderr;
-
-Returns the return value(s) of {&subroutine}. The sub is called in the same
-context as {capture()} was called e.g.:
-
- @rv = capture { wantarray } ; # returns true
- $rv = capture { wantarray } ; # returns defined, but not true
- capture { wantarray }; # void, returns undef
-
-{capture()} is able to capture output from subprocesses and C code, which
-traditional {tie()} methods of output capture are unable to do.
-
-*Note:* {capture()} will only capture output that has been written or flushed
-to the filehandle.
-
-If the two scalar references refer to the same scalar, then {STDERR} will be
-merged to {STDOUT} before capturing and the scalar will hold the combined
-output of both.
-
- capture \&subroutine, \$combined, \$combined;
-
-Normally, {capture()} uses anonymous, temporary files for capturing output.
-If desired, specific file names may be provided instead as additional options.
-
- capture \&subroutine, \$stdout, \$stderr, $out_file, $err_file;
-
-Files provided will be clobbered, overwriting any previous data, but
-will persist after the call to {capture()} for inspection or other manipulation.
-
-By default, when no references are provided to hold STDOUT or STDERR, output
-is captured and silently discarded.
-
- # Capture STDOUT, discard STDERR
- capture \&subroutine, \$stdout;
-
- # Discard STDOUT, capture STDERR
- capture \&subroutine, undef, \$stderr;
-
-If either STDOUT or STDERR should be passed through to the terminal instead of
-captured, provide a reference to undef -- {\undef} -- instead of a capture
-variable.
-
- # Capture STDOUT, display STDERR
- capture \&subroutine, \$stdout, \undef;
-
- # Display STDOUT, capture STDERR
- capture \&subroutine, \undef, \$stderr;
-
-== capture_exec()
-
- ($stdout, $stderr) = capture_exec(@args);
-
-Captures and returns the output from {system(@args)}. In scalar context,
-{capture_exec()} will return what was printed to {STDOUT}. In list context,
-it returns what was printed to {STDOUT} and {STDERR}
-
- $stdout = capture_exec('perl', '-e', 'print "hello world"');
-
- ($stdout, $stderr) = capture_exec('perl', '-e', 'warn "Test"');
-
-{capture_exec} passes its arguments to {system()} and on MSWin32 will protect
-arguments with shell quotes if necessary. This makes it a handy and slightly
-more portable alternative to backticks, piped {open()} and {IPC::Open3}.
-
-You can check the exit status of the {system()} call with the {$?}
-variable. See [perlvar] for more information.
-
-== capture_exec_combined()
-
- $combined = capture_exec_combined(
- 'perl', '-e', 'print "hello\n"', 'warn "Test\n"
- );
-
-This is just like {capture_exec()}, except that it merges {STDERR} with {STDOUT}
-before capturing output and returns a single scalar.
-
-*Note:* there is no guarantee that text printed to {STDOUT} and {STDERR} in the
-subprocess will be appear in order. The actual order will depend on how IO
-buffering is handled in the subprocess.
-
-== qxx()
-
-This is an alias for {capture_exec()}.
-
-== qxy()
-
-This is an alias for {capture_exec_combined()}.
-
-= SEE ALSO
-
-* [IPC::Open3]
-* [IO::Capture]
-* [IO::Utils]
-
-= AUTHORS
-
-* Simon Flack <simonflk _AT_ cpan.org> (original author)
-* David Golden <dagolden _AT_ cpan.org> (co-maintainer since version 1.04)
-
-= COPYRIGHT AND LICENSE
-
-Portions copyright 2004, 2005 Simon Flack. Portions copyright 2007 David
-Golden. All rights reserved.
-
-You may distribute under the terms of either the GNU General Public License or
-the Artistic License, as specified in the Perl README file.
-
-=end wikidoc
-
-=cut
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/IO/CaptureOutput.pod b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/IO/CaptureOutput.pod
deleted file mode 100644
index 16d2e152c04..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/IO/CaptureOutput.pod
+++ /dev/null
@@ -1,180 +0,0 @@
-# Generated by Pod::WikiDoc version 0.18
-
-=pod
-
-
-=head1 NAME
-
-IO::CaptureOutput - capture STDOUT and STDERR from Perl code, subprocesses or XS
-
-=head1 VERSION
-
-This documentation describes version 1.0801.
-
-=head1 SYNOPSIS
-
- use IO::CaptureOutput qw(capture capture_exec);
-
- my ($stdout, $stderr);
-
- sub noisy {
- warn "this sub prints to stdout and stderr!";
- print "arguments: @_";
- }
-
- capture { noisy(@args) } \$stdout, \$stderr;
-
- ($stdout, $stderr) = capture_exec( 'perl', '-e',
- 'print "Hello"; print STDERR "World!"');
-
-=head1 DESCRIPTION
-
-This module provides routines for capturing STDOUT and STDERR from perl
-subroutines, forked system calls (e.g. C<<< system() >>>, C<<< fork() >>>) and from
-XS or C modules.
-
-=head1 FUNCTIONS
-
-The following functions will be exported on demand.
-
-=head2 capture()
-
- capture \&subroutine, \$stdout, \$stderr;
-
-Captures everything printed to C<<< STDOUT >>> and C<<< STDERR >>> for the duration of
-C<<< &subroutine >>>. C<<< $stdout >>> and C<<< $stderr >>> are optional scalars that will contain
-C<<< STDOUT >>> and C<<< STDERR >>> respectively.
-
-C<<< capture() >>> uses a code prototype so the first argument can be specified directly within
-brackets if desired.
-
- # shorthand with prototype
- capture { print __PACKAGE__ } \$stdout, \$stderr;
-
-Returns the return value(s) of C<<< &subroutine >>>. The sub is called in the same
-context as C<<< capture() >>> was called e.g.:
-
- @rv = capture { wantarray } ; # returns true
- $rv = capture { wantarray } ; # returns defined, but not true
- capture { wantarray }; # void, returns undef
-
-C<<< capture() >>> is able to capture output from subprocesses and C code, which
-traditional C<<< tie() >>> methods of output capture are unable to do.
-
-B<Note:> C<<< capture() >>> will only capture output that has been written or flushed
-to the filehandle.
-
-If the two scalar references refer to the same scalar, then C<<< STDERR >>> will be
-merged to C<<< STDOUT >>> before capturing and the scalar will hold the combined
-output of both.
-
- capture \&subroutine, \$combined, \$combined;
-
-Normally, C<<< capture() >>> uses anonymous, temporary files for capturing output.
-If desired, specific file names may be provided instead as additional options.
-
- capture \&subroutine, \$stdout, \$stderr, $out_file, $err_file;
-
-Files provided will be clobbered, overwriting any previous data, but
-will persist after the call to C<<< capture() >>> for inspection or other manipulation.
-
-By default, when no references are provided to hold STDOUT or STDERR, output
-is captured and silently discarded.
-
- # Capture STDOUT, discard STDERR
- capture \&subroutine, \$stdout;
-
- # Discard STDOUT, capture STDERR
- capture \&subroutine, undef, \$stderr;
-
-If either STDOUT or STDERR should be passed through to the terminal instead of
-captured, provide a reference to undef -- C<<< \undef >>> -- instead of a capture
-variable.
-
- # Capture STDOUT, display STDERR
- capture \&subroutine, \$stdout, \undef;
-
- # Display STDOUT, capture STDERR
- capture \&subroutine, \undef, \$stderr;
-
-=head2 capture_exec()
-
- ($stdout, $stderr) = capture_exec(@args);
-
-Captures and returns the output from C<<< system(@args) >>>. In scalar context,
-C<<< capture_exec() >>> will return what was printed to C<<< STDOUT >>>. In list context,
-it returns what was printed to C<<< STDOUT >>> and C<<< STDERR >>>
-
- $stdout = capture_exec('perl', '-e', 'print "hello world"');
-
- ($stdout, $stderr) = capture_exec('perl', '-e', 'warn "Test"');
-
-C<<< capture_exec >>> passes its arguments to C<<< system() >>> and on MSWin32 will protect
-arguments with shell quotes if necessary. This makes it a handy and slightly
-more portable alternative to backticks, piped C<<< open() >>> and C<<< IPC::Open3 >>>.
-
-You can check the exit status of the C<<< system() >>> call with the C<<< $? >>>
-variable. See L<perlvar> for more information.
-
-=head2 capture_exec_combined()
-
- $combined = capture_exec_combined(
- 'perl', '-e', 'print "hello\n"', 'warn "Test\n"
- );
-
-This is just like C<<< capture_exec() >>>, except that it merges C<<< STDERR >>> with C<<< STDOUT >>>
-before capturing output and returns a single scalar.
-
-B<Note:> there is no guarantee that text printed to C<<< STDOUT >>> and C<<< STDERR >>> in the
-subprocess will be appear in order. The actual order will depend on how IO
-buffering is handled in the subprocess.
-
-=head2 qxx()
-
-This is an alias for C<<< capture_exec() >>>.
-
-=head2 qxy()
-
-This is an alias for C<<< capture_exec_combined() >>>.
-
-=head1 SEE ALSO
-
-=over
-
-=item *
-
-L<IPC::Open3>
-
-=item *
-
-L<IO::Capture>
-
-=item *
-
-L<IO::Utils>
-
-=back
-
-=head1 AUTHORS
-
-=over
-
-=item *
-
-Simon Flack E<lt>simonflk _AT_ cpan.orgE<gt> (original author)
-
-=item *
-
-David Golden E<lt>dagolden _AT_ cpan.orgE<gt> (co-maintainer since version 1.04)
-
-=back
-
-=head1 COPYRIGHT AND LICENSE
-
-Portions copyright 2004, 2005 Simon Flack. Portions copyright 2007 David
-Golden. All rights reserved.
-
-You may distribute under the terms of either the GNU General Public License or
-the Artistic License, as specified in the Perl README file.
-
-
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/IO/Compress/Adapter/Bzip2.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/IO/Compress/Adapter/Bzip2.pm
deleted file mode 100644
index 1c2e10a13d7..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/IO/Compress/Adapter/Bzip2.pm
+++ /dev/null
@@ -1,162 +0,0 @@
-package IO::Compress::Adapter::Bzip2 ;
-
-use strict;
-use warnings;
-use bytes;
-
-use IO::Compress::Base::Common 2.011 qw(:Status);
-
-#use Compress::Bzip2 ;
-use Compress::Raw::Bzip2 2.011 ;
-
-our ($VERSION);
-$VERSION = '2.011';
-
-sub mkCompObject
-{
- my $BlockSize100K = shift ;
- my $WorkFactor = shift ;
- my $Verbosity = shift ;
-
- my ($def, $status) = new Compress::Raw::Bzip2(1, $BlockSize100K,
- $WorkFactor, $Verbosity);
- #my ($def, $status) = bzdeflateInit();
- #-BlockSize100K => $params->value('BlockSize100K'),
- #-WorkFactor => $params->value('WorkFactor');
-
- return (undef, "Could not create Deflate object: $status", $status)
- if $status != BZ_OK ;
-
- return bless {'Def' => $def,
- 'Error' => '',
- 'ErrorNo' => 0,
- } ;
-}
-
-sub compr
-{
- my $self = shift ;
-
- my $def = $self->{Def};
-
- #my ($out, $status) = $def->bzdeflate(defined ${$_[0]} ? ${$_[0]} : "") ;
- my $status = $def->bzdeflate($_[0], $_[1]) ;
- $self->{ErrorNo} = $status;
-
- if ($status != BZ_RUN_OK)
- {
- $self->{Error} = "Deflate Error: $status";
- return STATUS_ERROR;
- }
-
- #${ $_[1] } .= $out if defined $out;
-
- return STATUS_OK;
-}
-
-sub flush
-{
- my $self = shift ;
-
- my $def = $self->{Def};
-
- #my ($out, $status) = $def->bzflush($opt);
- #my $status = $def->bzflush($_[0], $opt);
- my $status = $def->bzflush($_[0]);
- $self->{ErrorNo} = $status;
-
- if ($status != BZ_RUN_OK)
- {
- $self->{Error} = "Deflate Error: $status";
- return STATUS_ERROR;
- }
-
- #${ $_[0] } .= $out if defined $out ;
- return STATUS_OK;
-
-}
-
-sub close
-{
- my $self = shift ;
-
- my $def = $self->{Def};
-
- #my ($out, $status) = $def->bzclose();
- my $status = $def->bzclose($_[0]);
- $self->{ErrorNo} = $status;
-
- if ($status != BZ_STREAM_END)
- {
- $self->{Error} = "Deflate Error: $status";
- return STATUS_ERROR;
- }
-
- #${ $_[0] } .= $out if defined $out ;
- return STATUS_OK;
-
-}
-
-
-sub reset
-{
- my $self = shift ;
-
- my $outer = $self->{Outer};
-
- my ($def, $status) = new Compress::Raw::Bzip2();
- $self->{ErrorNo} = ($status == BZ_OK) ? 0 : $status ;
-
- if ($status != BZ_OK)
- {
- $self->{Error} = "Cannot create Deflate object: $status";
- return STATUS_ERROR;
- }
-
- $self->{Def} = $def;
-
- return STATUS_OK;
-}
-
-sub compressedBytes
-{
- my $self = shift ;
- $self->{Def}->compressedBytes();
-}
-
-sub uncompressedBytes
-{
- my $self = shift ;
- $self->{Def}->uncompressedBytes();
-}
-
-#sub total_out
-#{
-# my $self = shift ;
-# 0;
-#}
-#
-
-#sub total_in
-#{
-# my $self = shift ;
-# $self->{Def}->total_in();
-#}
-#
-#sub crc32
-#{
-# my $self = shift ;
-# $self->{Def}->crc32();
-#}
-#
-#sub adler32
-#{
-# my $self = shift ;
-# $self->{Def}->adler32();
-#}
-
-
-1;
-
-__END__
-
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/IO/Compress/Bzip2.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/IO/Compress/Bzip2.pm
deleted file mode 100644
index 591f326c46e..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/IO/Compress/Bzip2.pm
+++ /dev/null
@@ -1,758 +0,0 @@
-package IO::Compress::Bzip2 ;
-
-use strict ;
-use warnings;
-use bytes;
-require Exporter ;
-
-use IO::Compress::Base 2.011 ;
-
-use IO::Compress::Base::Common 2.011 qw(createSelfTiedObject);
-use IO::Compress::Adapter::Bzip2 2.011 ;
-
-
-
-our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, $Bzip2Error);
-
-$VERSION = '2.011';
-$Bzip2Error = '';
-
-@ISA = qw(Exporter IO::Compress::Base);
-@EXPORT_OK = qw( $Bzip2Error bzip2 ) ;
-%EXPORT_TAGS = %IO::Compress::Base::EXPORT_TAGS ;
-push @{ $EXPORT_TAGS{all} }, @EXPORT_OK ;
-Exporter::export_ok_tags('all');
-
-
-
-sub new
-{
- my $class = shift ;
-
- my $obj = createSelfTiedObject($class, \$Bzip2Error);
- return $obj->_create(undef, @_);
-}
-
-sub bzip2
-{
- my $obj = createSelfTiedObject(undef, \$Bzip2Error);
- $obj->_def(@_);
-}
-
-
-sub mkHeader
-{
- my $self = shift ;
- return '';
-
-}
-
-sub getExtraParams
-{
- my $self = shift ;
-
- use IO::Compress::Base::Common 2.011 qw(:Parse);
-
- return (
- 'BlockSize100K' => [0, 1, Parse_unsigned, 1],
- 'WorkFactor' => [0, 1, Parse_unsigned, 0],
- 'Verbosity' => [0, 1, Parse_boolean, 0],
- );
-}
-
-
-
-sub ckParams
-{
- my $self = shift ;
- my $got = shift;
-
- # check that BlockSize100K is a number between 1 & 9
- if ($got->parsed('BlockSize100K')) {
- my $value = $got->value('BlockSize100K');
- return $self->saveErrorString(undef, "Parameter 'BlockSize100K' not between 1 and 9, got $value")
- unless defined $value && $value >= 1 && $value <= 9;
-
- }
-
- # check that WorkFactor between 0 & 250
- if ($got->parsed('WorkFactor')) {
- my $value = $got->value('WorkFactor');
- return $self->saveErrorString(undef, "Parameter 'WorkFactor' not between 0 and 250, got $value")
- unless $value >= 0 && $value <= 250;
- }
-
- return 1 ;
-}
-
-
-sub mkComp
-{
- my $self = shift ;
- my $got = shift ;
-
- my $BlockSize100K = $got->value('BlockSize100K');
- my $WorkFactor = $got->value('WorkFactor');
- my $Verbosity = $got->value('Verbosity');
-
- my ($obj, $errstr, $errno) = IO::Compress::Adapter::Bzip2::mkCompObject(
- $BlockSize100K, $WorkFactor,
- $Verbosity);
-
- return $self->saveErrorString(undef, $errstr, $errno)
- if ! defined $obj;
-
- return $obj;
-}
-
-
-sub mkTrailer
-{
- my $self = shift ;
- return '';
-}
-
-sub mkFinalTrailer
-{
- return '';
-}
-
-#sub newHeader
-#{
-# my $self = shift ;
-# return '';
-#}
-
-sub getInverseClass
-{
- return ('IO::Uncompress::Bunzip2');
-}
-
-sub getFileInfo
-{
- my $self = shift ;
- my $params = shift;
- my $file = shift ;
-
-}
-
-1;
-
-__END__
-
-=head1 NAME
-
-IO::Compress::Bzip2 - Write bzip2 files/buffers
-
-
-
-=head1 SYNOPSIS
-
- use IO::Compress::Bzip2 qw(bzip2 $Bzip2Error) ;
-
- my $status = bzip2 $input => $output [,OPTS]
- or die "bzip2 failed: $Bzip2Error\n";
-
- my $z = new IO::Compress::Bzip2 $output [,OPTS]
- or die "bzip2 failed: $Bzip2Error\n";
-
- $z->print($string);
- $z->printf($format, $string);
- $z->write($string);
- $z->syswrite($string [, $length, $offset]);
- $z->flush();
- $z->tell();
- $z->eof();
- $z->seek($position, $whence);
- $z->binmode();
- $z->fileno();
- $z->opened();
- $z->autoflush();
- $z->input_line_number();
- $z->newStream( [OPTS] );
-
- $z->close() ;
-
- $Bzip2Error ;
-
- # IO::File mode
-
- print $z $string;
- printf $z $format, $string;
- tell $z
- eof $z
- seek $z, $position, $whence
- binmode $z
- fileno $z
- close $z ;
-
-
-=head1 DESCRIPTION
-
-This module provides a Perl interface that allows writing bzip2
-compressed data to files or buffer.
-
-For reading bzip2 files/buffers, see the companion module
-L<IO::Uncompress::Bunzip2|IO::Uncompress::Bunzip2>.
-
-=head1 Functional Interface
-
-A top-level function, C<bzip2>, is provided to carry out
-"one-shot" compression between buffers and/or files. For finer
-control over the compression process, see the L</"OO Interface">
-section.
-
- use IO::Compress::Bzip2 qw(bzip2 $Bzip2Error) ;
-
- bzip2 $input => $output [,OPTS]
- or die "bzip2 failed: $Bzip2Error\n";
-
-The functional interface needs Perl5.005 or better.
-
-=head2 bzip2 $input => $output [, OPTS]
-
-C<bzip2> expects at least two parameters, C<$input> and C<$output>.
-
-=head3 The C<$input> parameter
-
-The parameter, C<$input>, is used to define the source of
-the uncompressed data.
-
-It can take one of the following forms:
-
-=over 5
-
-=item A filename
-
-If the C<$input> parameter is a simple scalar, it is assumed to be a
-filename. This file will be opened for reading and the input data
-will be read from it.
-
-=item A filehandle
-
-If the C<$input> parameter is a filehandle, the input data will be
-read from it.
-The string '-' can be used as an alias for standard input.
-
-=item A scalar reference
-
-If C<$input> is a scalar reference, the input data will be read
-from C<$$input>.
-
-=item An array reference
-
-If C<$input> is an array reference, each element in the array must be a
-filename.
-
-The input data will be read from each file in turn.
-
-The complete array will be walked to ensure that it only
-contains valid filenames before any data is compressed.
-
-=item An Input FileGlob string
-
-If C<$input> is a string that is delimited by the characters "<" and ">"
-C<bzip2> will assume that it is an I<input fileglob string>. The
-input is the list of files that match the fileglob.
-
-If the fileglob does not match any files ...
-
-See L<File::GlobMapper|File::GlobMapper> for more details.
-
-=back
-
-If the C<$input> parameter is any other type, C<undef> will be returned.
-
-=head3 The C<$output> parameter
-
-The parameter C<$output> is used to control the destination of the
-compressed data. This parameter can take one of these forms.
-
-=over 5
-
-=item A filename
-
-If the C<$output> parameter is a simple scalar, it is assumed to be a
-filename. This file will be opened for writing and the compressed
-data will be written to it.
-
-=item A filehandle
-
-If the C<$output> parameter is a filehandle, the compressed data
-will be written to it.
-The string '-' can be used as an alias for standard output.
-
-=item A scalar reference
-
-If C<$output> is a scalar reference, the compressed data will be
-stored in C<$$output>.
-
-=item An Array Reference
-
-If C<$output> is an array reference, the compressed data will be
-pushed onto the array.
-
-=item An Output FileGlob
-
-If C<$output> is a string that is delimited by the characters "<" and ">"
-C<bzip2> will assume that it is an I<output fileglob string>. The
-output is the list of files that match the fileglob.
-
-When C<$output> is an fileglob string, C<$input> must also be a fileglob
-string. Anything else is an error.
-
-=back
-
-If the C<$output> parameter is any other type, C<undef> will be returned.
-
-=head2 Notes
-
-When C<$input> maps to multiple files/buffers and C<$output> is a single
-file/buffer the input files/buffers will be stored
-in C<$output> as a concatenated series of compressed data streams.
-
-=head2 Optional Parameters
-
-Unless specified below, the optional parameters for C<bzip2>,
-C<OPTS>, are the same as those used with the OO interface defined in the
-L</"Constructor Options"> section below.
-
-=over 5
-
-=item C<< AutoClose => 0|1 >>
-
-This option applies to any input or output data streams to
-C<bzip2> that are filehandles.
-
-If C<AutoClose> is specified, and the value is true, it will result in all
-input and/or output filehandles being closed once C<bzip2> has
-completed.
-
-This parameter defaults to 0.
-
-=item C<< BinModeIn => 0|1 >>
-
-When reading from a file or filehandle, set C<binmode> before reading.
-
-Defaults to 0.
-
-=item C<< Append => 0|1 >>
-
-TODO
-
-=back
-
-=head2 Examples
-
-To read the contents of the file C<file1.txt> and write the compressed
-data to the file C<file1.txt.bz2>.
-
- use strict ;
- use warnings ;
- use IO::Compress::Bzip2 qw(bzip2 $Bzip2Error) ;
-
- my $input = "file1.txt";
- bzip2 $input => "$input.bz2"
- or die "bzip2 failed: $Bzip2Error\n";
-
-To read from an existing Perl filehandle, C<$input>, and write the
-compressed data to a buffer, C<$buffer>.
-
- use strict ;
- use warnings ;
- use IO::Compress::Bzip2 qw(bzip2 $Bzip2Error) ;
- use IO::File ;
-
- my $input = new IO::File "<file1.txt"
- or die "Cannot open 'file1.txt': $!\n" ;
- my $buffer ;
- bzip2 $input => \$buffer
- or die "bzip2 failed: $Bzip2Error\n";
-
-To compress all files in the directory "/my/home" that match "*.txt"
-and store the compressed data in the same directory
-
- use strict ;
- use warnings ;
- use IO::Compress::Bzip2 qw(bzip2 $Bzip2Error) ;
-
- bzip2 '</my/home/*.txt>' => '<*.bz2>'
- or die "bzip2 failed: $Bzip2Error\n";
-
-and if you want to compress each file one at a time, this will do the trick
-
- use strict ;
- use warnings ;
- use IO::Compress::Bzip2 qw(bzip2 $Bzip2Error) ;
-
- for my $input ( glob "/my/home/*.txt" )
- {
- my $output = "$input.bz2" ;
- bzip2 $input => $output
- or die "Error compressing '$input': $Bzip2Error\n";
- }
-
-=head1 OO Interface
-
-=head2 Constructor
-
-The format of the constructor for C<IO::Compress::Bzip2> is shown below
-
- my $z = new IO::Compress::Bzip2 $output [,OPTS]
- or die "IO::Compress::Bzip2 failed: $Bzip2Error\n";
-
-It returns an C<IO::Compress::Bzip2> object on success and undef on failure.
-The variable C<$Bzip2Error> will contain an error message on failure.
-
-If you are running Perl 5.005 or better the object, C<$z>, returned from
-IO::Compress::Bzip2 can be used exactly like an L<IO::File|IO::File> filehandle.
-This means that all normal output file operations can be carried out
-with C<$z>.
-For example, to write to a compressed file/buffer you can use either of
-these forms
-
- $z->print("hello world\n");
- print $z "hello world\n";
-
-The mandatory parameter C<$output> is used to control the destination
-of the compressed data. This parameter can take one of these forms.
-
-=over 5
-
-=item A filename
-
-If the C<$output> parameter is a simple scalar, it is assumed to be a
-filename. This file will be opened for writing and the compressed data
-will be written to it.
-
-=item A filehandle
-
-If the C<$output> parameter is a filehandle, the compressed data will be
-written to it.
-The string '-' can be used as an alias for standard output.
-
-=item A scalar reference
-
-If C<$output> is a scalar reference, the compressed data will be stored
-in C<$$output>.
-
-=back
-
-If the C<$output> parameter is any other type, C<IO::Compress::Bzip2>::new will
-return undef.
-
-=head2 Constructor Options
-
-C<OPTS> is any combination of the following options:
-
-=over 5
-
-=item C<< AutoClose => 0|1 >>
-
-This option is only valid when the C<$output> parameter is a filehandle. If
-specified, and the value is true, it will result in the C<$output> being
-closed once either the C<close> method is called or the C<IO::Compress::Bzip2>
-object is destroyed.
-
-This parameter defaults to 0.
-
-=item C<< Append => 0|1 >>
-
-Opens C<$output> in append mode.
-
-The behaviour of this option is dependent on the type of C<$output>.
-
-=over 5
-
-=item * A Buffer
-
-If C<$output> is a buffer and C<Append> is enabled, all compressed data
-will be append to the end if C<$output>. Otherwise C<$output> will be
-cleared before any data is written to it.
-
-=item * A Filename
-
-If C<$output> is a filename and C<Append> is enabled, the file will be
-opened in append mode. Otherwise the contents of the file, if any, will be
-truncated before any compressed data is written to it.
-
-=item * A Filehandle
-
-If C<$output> is a filehandle, the file pointer will be positioned to the
-end of the file via a call to C<seek> before any compressed data is written
-to it. Otherwise the file pointer will not be moved.
-
-=back
-
-This parameter defaults to 0.
-
-=item C<< BlockSize100K => number >>
-
-Specify the number of 100K blocks bzip2 uses during compression.
-
-Valid values are from 1 to 9, where 9 is best compression.
-
-The default is 1.
-
-=item C<< WorkFactor => number >>
-
-Specifies how much effort bzip2 should take before resorting to a slower
-fallback compression algorithm.
-
-Valid values range from 0 to 250, where 0 means use the default value 30.
-
-The default is 0.
-
-=item C<< Strict => 0|1 >>
-
-This is a placeholder option.
-
-=back
-
-=head2 Examples
-
-TODO
-
-=head1 Methods
-
-=head2 print
-
-Usage is
-
- $z->print($data)
- print $z $data
-
-Compresses and outputs the contents of the C<$data> parameter. This
-has the same behaviour as the C<print> built-in.
-
-Returns true if successful.
-
-=head2 printf
-
-Usage is
-
- $z->printf($format, $data)
- printf $z $format, $data
-
-Compresses and outputs the contents of the C<$data> parameter.
-
-Returns true if successful.
-
-=head2 syswrite
-
-Usage is
-
- $z->syswrite $data
- $z->syswrite $data, $length
- $z->syswrite $data, $length, $offset
-
-Compresses and outputs the contents of the C<$data> parameter.
-
-Returns the number of uncompressed bytes written, or C<undef> if
-unsuccessful.
-
-=head2 write
-
-Usage is
-
- $z->write $data
- $z->write $data, $length
- $z->write $data, $length, $offset
-
-Compresses and outputs the contents of the C<$data> parameter.
-
-Returns the number of uncompressed bytes written, or C<undef> if
-unsuccessful.
-
-=head2 flush
-
-Usage is
-
- $z->flush;
-
-Flushes any pending compressed data to the output file/buffer.
-
-TODO
-
-Returns true on success.
-
-=head2 tell
-
-Usage is
-
- $z->tell()
- tell $z
-
-Returns the uncompressed file offset.
-
-=head2 eof
-
-Usage is
-
- $z->eof();
- eof($z);
-
-Returns true if the C<close> method has been called.
-
-=head2 seek
-
- $z->seek($position, $whence);
- seek($z, $position, $whence);
-
-Provides a sub-set of the C<seek> functionality, with the restriction
-that it is only legal to seek forward in the output file/buffer.
-It is a fatal error to attempt to seek backward.
-
-Empty parts of the file/buffer will have NULL (0x00) bytes written to them.
-
-The C<$whence> parameter takes one the usual values, namely SEEK_SET,
-SEEK_CUR or SEEK_END.
-
-Returns 1 on success, 0 on failure.
-
-=head2 binmode
-
-Usage is
-
- $z->binmode
- binmode $z ;
-
-This is a noop provided for completeness.
-
-=head2 opened
-
- $z->opened()
-
-Returns true if the object currently refers to a opened file/buffer.
-
-=head2 autoflush
-
- my $prev = $z->autoflush()
- my $prev = $z->autoflush(EXPR)
-
-If the C<$z> object is associated with a file or a filehandle, this method
-returns the current autoflush setting for the underlying filehandle. If
-C<EXPR> is present, and is non-zero, it will enable flushing after every
-write/print operation.
-
-If C<$z> is associated with a buffer, this method has no effect and always
-returns C<undef>.
-
-B<Note> that the special variable C<$|> B<cannot> be used to set or
-retrieve the autoflush setting.
-
-=head2 input_line_number
-
- $z->input_line_number()
- $z->input_line_number(EXPR)
-
-This method always returns C<undef> when compressing.
-
-=head2 fileno
-
- $z->fileno()
- fileno($z)
-
-If the C<$z> object is associated with a file or a filehandle, C<fileno>
-will return the underlying file descriptor. Once the C<close> method is
-called C<fileno> will return C<undef>.
-
-If the C<$z> object is is associated with a buffer, this method will return
-C<undef>.
-
-=head2 close
-
- $z->close() ;
- close $z ;
-
-Flushes any pending compressed data and then closes the output file/buffer.
-
-For most versions of Perl this method will be automatically invoked if
-the IO::Compress::Bzip2 object is destroyed (either explicitly or by the
-variable with the reference to the object going out of scope). The
-exceptions are Perl versions 5.005 through 5.00504 and 5.8.0. In
-these cases, the C<close> method will be called automatically, but
-not until global destruction of all live objects when the program is
-terminating.
-
-Therefore, if you want your scripts to be able to run on all versions
-of Perl, you should call C<close> explicitly and not rely on automatic
-closing.
-
-Returns true on success, otherwise 0.
-
-If the C<AutoClose> option has been enabled when the IO::Compress::Bzip2
-object was created, and the object is associated with a file, the
-underlying file will also be closed.
-
-=head2 newStream([OPTS])
-
-Usage is
-
- $z->newStream( [OPTS] )
-
-Closes the current compressed data stream and starts a new one.
-
-OPTS consists of any of the the options that are available when creating
-the C<$z> object.
-
-See the L</"Constructor Options"> section for more details.
-
-=head1 Importing
-
-No symbolic constants are required by this IO::Compress::Bzip2 at present.
-
-=over 5
-
-=item :all
-
-Imports C<bzip2> and C<$Bzip2Error>.
-Same as doing this
-
- use IO::Compress::Bzip2 qw(bzip2 $Bzip2Error) ;
-
-
-
-=back
-
-=head1 EXAMPLES
-
-=head2 Apache::GZip Revisited
-
-See L<IO::Compress::Bzip2::FAQ|IO::Compress::Bzip2::FAQ/"Apache::GZip Revisited">
-
-
-
-=head2 Working with Net::FTP
-
-See L<IO::Compress::Bzip2::FAQ|IO::Compress::Bzip2::FAQ/"Compressed files and Net::FTP">
-
-=head1 SEE ALSO
-
-L<Compress::Zlib>, L<IO::Compress::Gzip>, L<IO::Uncompress::Gunzip>, L<IO::Compress::Deflate>, L<IO::Uncompress::Inflate>, L<IO::Compress::RawDeflate>, L<IO::Uncompress::RawInflate>, L<IO::Uncompress::Bunzip2>, L<IO::Compress::Lzop>, L<IO::Uncompress::UnLzop>, L<IO::Compress::Lzf>, L<IO::Uncompress::UnLzf>, L<IO::Uncompress::AnyInflate>, L<IO::Uncompress::AnyUncompress>
-
-L<Compress::Zlib::FAQ|Compress::Zlib::FAQ>
-
-L<File::GlobMapper|File::GlobMapper>, L<Archive::Zip|Archive::Zip>,
-L<Archive::Tar|Archive::Tar>,
-L<IO::Zlib|IO::Zlib>
-
-The primary site for the bzip2 program is F<http://www.bzip.org>.
-
-See the module L<Compress::Bzip2|Compress::Bzip2>
-
-=head1 AUTHOR
-
-This module was written by Paul Marquess, F<pmqs@cpan.org>.
-
-=head1 MODIFICATION HISTORY
-
-See the Changes file.
-
-=head1 COPYRIGHT AND LICENSE
-
-Copyright (c) 2005-2008 Paul Marquess. All rights reserved.
-
-This program is free software; you can redistribute it and/or
-modify it under the same terms as Perl itself.
-
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/IO/String.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/IO/String.pm
deleted file mode 100644
index 4bc8e719601..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/IO/String.pm
+++ /dev/null
@@ -1,551 +0,0 @@
-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/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/IO/Uncompress/Adapter/Bunzip2.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/IO/Uncompress/Adapter/Bunzip2.pm
deleted file mode 100644
index 9770689f5fd..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/IO/Uncompress/Adapter/Bunzip2.pm
+++ /dev/null
@@ -1,199 +0,0 @@
-package IO::Uncompress::Adapter::Bunzip2;
-
-use strict;
-use warnings;
-use bytes;
-
-use IO::Compress::Base::Common 2.011 qw(:Status);
-
-#use Compress::Bzip2 ;
-use Compress::Raw::Bzip2 2.011 ;
-
-our ($VERSION, @ISA);
-$VERSION = '2.011';
-
-#@ISA = qw( Compress::Raw::Bunzip2 );
-
-
-sub mkUncompObject
-{
- my $small = shift || 0;
- my $verbosity = shift || 0;
-
- #my ($inflate, $status) = bzinflateInit;
- #Small => $params->value('Small');
- my ($inflate, $status) = new Compress::Raw::Bunzip2(1, 1, $small, $verbosity);
-
- return (undef, "Could not create Inflation object: $status", $status)
- if $status != BZ_OK ;
-
- return bless {'Inf' => $inflate,
- 'CompSize' => 0,
- 'UnCompSize' => 0,
- 'Error' => '',
- } ;
-
-}
-
-sub uncompr
-{
- my $self = shift ;
- my $from = shift ;
- my $to = shift ;
- my $eof = shift ;
-
- my $inf = $self->{Inf};
-
- my $status = $inf->bzinflate($from, $to);
- $self->{ErrorNo} = $status;
-
- if ($status != BZ_STREAM_END && $eof)
- {
- $self->{Error} = "unexpected end of file";
- return STATUS_ERROR;
- }
-
- if ($status != BZ_OK && $status != BZ_STREAM_END )
- {
- $self->{Error} = "Inflation Error: $status";
- return STATUS_ERROR;
- }
-
-
- return STATUS_OK if $status == BZ_OK ;
- return STATUS_ENDSTREAM if $status == BZ_STREAM_END ;
- return STATUS_ERROR ;
-}
-
-
-#sub uncompr
-#{
-# my $self = shift ;
-#
-# my $inf = $self->{Inf};
-# my $eof = $_[2];
-#
-# #my ($out, $status) = $inf->bzinflate(${ $_[0] });
-# my $status = $inf->bzinflate($_[0], $_[1]);
-# $self->{ErrorNo} = $status;
-#
-# if (! defined $out)
-# {
-# my $err = $inf->error();
-# $self->{Error} = "Inflation Error: $err";
-# return STATUS_ERROR;
-# }
-#
-# #${ $_[1] } .= $out if defined $out;
-#
-# if ($eof)
-# {
-# #my ($out, $status) = $inf->bzclose();
-# $status = $inf->bzclose($_[1]);
-# $self->{ErrorNo} = $status;
-#
-# if (! defined $out)
-# {
-# my $err = $inf->error();
-# $self->{Error} = "Inflation Error: $err";
-# return STATUS_ERROR;
-# }
-#
-# #${ $_[1] } .= $out if defined $out;
-# return STATUS_ENDSTREAM ;
-# }
-#
-# return STATUS_OK ;
-#}
-
-#sub uncompr
-#{
-# my $self = shift ;
-#
-# my $inf = $self->{Inf};
-# my $eof = $_[2];
-#
-# my ($out, $status) = $inf->bzinflate(${ $_[0] });
-# $self->{ErrorNo} = $status;
-#
-# if ($status != BZ_STREAM_END && $eof)
-# {
-# $self->{Error} = "unexpected end of file";
-# return STATUS_ERROR;
-# }
-#
-# if ($status != BZ_OK && $status != BZ_STREAM_END )
-# {
-# my $err = $inf->error();
-# $self->{Error} = "Inflation Error: $err";
-# return STATUS_ERROR;
-# }
-#
-# ${ $_[1] } .= $out ;
-#
-# return STATUS_OK if $status == BZ_OK ;
-# return STATUS_ENDSTREAM if $status == BZ_STREAM_END ;
-# return STATUS_ERROR ;
-#}
-
-sub reset
-{
- my $self = shift ;
-
- my ($inf, $status) = new Compress::Raw::Bunzip2();
- $self->{ErrorNo} = ($status == BZ_OK) ? 0 : $status ;
-
- if ($status != BZ_OK)
- {
- $self->{Error} = "Cannot create Inflate object: $status";
- return STATUS_ERROR;
- }
-
- $self->{Inf} = $inf;
-
- return STATUS_OK ;
-}
-
-#sub count
-#{
-# my $self = shift ;
-# $self->{Inf}->inflateCount();
-#}
-
-sub compressedBytes
-{
- my $self = shift ;
- $self->{Inf}->compressedBytes();
-}
-
-sub uncompressedBytes
-{
- my $self = shift ;
- $self->{Inf}->uncompressedBytes();
-}
-
-sub crc32
-{
- my $self = shift ;
- #$self->{Inf}->crc32();
-}
-
-sub adler32
-{
- my $self = shift ;
- #$self->{Inf}->adler32();
-}
-
-sub sync
-{
- my $self = shift ;
- #( $self->{Inf}->inflateSync(@_) == BZ_OK)
- # ? STATUS_OK
- # : STATUS_ERROR ;
-}
-
-
-1;
-
-__END__
-
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/IO/Uncompress/Bunzip2.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/IO/Uncompress/Bunzip2.pm
deleted file mode 100644
index 0f7fe89de1a..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/IO/Uncompress/Bunzip2.pm
+++ /dev/null
@@ -1,858 +0,0 @@
-package IO::Uncompress::Bunzip2 ;
-
-use strict ;
-use warnings;
-use bytes;
-
-use IO::Compress::Base::Common 2.011 qw(:Status createSelfTiedObject);
-
-use IO::Uncompress::Base 2.011 ;
-use IO::Uncompress::Adapter::Bunzip2 2.011 ;
-
-require Exporter ;
-our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, $Bunzip2Error);
-
-$VERSION = '2.011';
-$Bunzip2Error = '';
-
-@ISA = qw( Exporter IO::Uncompress::Base );
-@EXPORT_OK = qw( $Bunzip2Error bunzip2 ) ;
-#%EXPORT_TAGS = %IO::Uncompress::Base::EXPORT_TAGS ;
-push @{ $EXPORT_TAGS{all} }, @EXPORT_OK ;
-#Exporter::export_ok_tags('all');
-
-
-sub new
-{
- my $class = shift ;
- my $obj = createSelfTiedObject($class, \$Bunzip2Error);
-
- $obj->_create(undef, 0, @_);
-}
-
-sub bunzip2
-{
- my $obj = createSelfTiedObject(undef, \$Bunzip2Error);
- return $obj->_inf(@_);
-}
-
-sub getExtraParams
-{
- my $self = shift ;
-
- use IO::Compress::Base::Common 2.011 qw(:Parse);
-
- return (
- 'Verbosity' => [1, 1, Parse_boolean, 0],
- 'Small' => [1, 1, Parse_boolean, 0],
- );
-}
-
-
-sub ckParams
-{
- my $self = shift ;
- my $got = shift ;
-
- return 1;
-}
-
-sub mkUncomp
-{
- my $self = shift ;
- my $got = shift ;
-
- my $magic = $self->ckMagic()
- or return 0;
-
- *$self->{Info} = $self->readHeader($magic)
- or return undef ;
-
- my $Small = $got->value('Small');
- my $Verbosity = $got->value('Verbosity');
-
- my ($obj, $errstr, $errno) = IO::Uncompress::Adapter::Bunzip2::mkUncompObject(
- $Small, $Verbosity);
-
- return $self->saveErrorString(undef, $errstr, $errno)
- if ! defined $obj;
-
- *$self->{Uncomp} = $obj;
-
- return 1;
-
-}
-
-
-sub ckMagic
-{
- my $self = shift;
-
- my $magic ;
- $self->smartReadExact(\$magic, 4);
-
- *$self->{HeaderPending} = $magic ;
-
- return $self->HeaderError("Header size is " .
- 4 . " bytes")
- if length $magic != 4;
-
- return $self->HeaderError("Bad Magic.")
- if ! isBzip2Magic($magic) ;
-
-
- *$self->{Type} = 'bzip2';
- return $magic;
-}
-
-sub readHeader
-{
- my $self = shift;
- my $magic = shift ;
-
- $self->pushBack($magic);
- *$self->{HeaderPending} = '';
-
-
- return {
- 'Type' => 'bzip2',
- 'FingerprintLength' => 4,
- 'HeaderLength' => 4,
- 'TrailerLength' => 0,
- 'Header' => '$magic'
- };
-
-}
-
-sub chkTrailer
-{
- return STATUS_OK;
-}
-
-
-
-sub isBzip2Magic
-{
- my $buffer = shift ;
- return $buffer =~ /^BZh\d$/;
-}
-
-1 ;
-
-__END__
-
-
-=head1 NAME
-
-IO::Uncompress::Bunzip2 - Read bzip2 files/buffers
-
-=head1 SYNOPSIS
-
- use IO::Uncompress::Bunzip2 qw(bunzip2 $Bunzip2Error) ;
-
- my $status = bunzip2 $input => $output [,OPTS]
- or die "bunzip2 failed: $Bunzip2Error\n";
-
- my $z = new IO::Uncompress::Bunzip2 $input [OPTS]
- or die "bunzip2 failed: $Bunzip2Error\n";
-
- $status = $z->read($buffer)
- $status = $z->read($buffer, $length)
- $status = $z->read($buffer, $length, $offset)
- $line = $z->getline()
- $char = $z->getc()
- $char = $z->ungetc()
- $char = $z->opened()
-
- $data = $z->trailingData()
- $status = $z->nextStream()
- $data = $z->getHeaderInfo()
- $z->tell()
- $z->seek($position, $whence)
- $z->binmode()
- $z->fileno()
- $z->eof()
- $z->close()
-
- $Bunzip2Error ;
-
- # IO::File mode
-
- <$z>
- read($z, $buffer);
- read($z, $buffer, $length);
- read($z, $buffer, $length, $offset);
- tell($z)
- seek($z, $position, $whence)
- binmode($z)
- fileno($z)
- eof($z)
- close($z)
-
-=head1 DESCRIPTION
-
-This module provides a Perl interface that allows the reading of
-bzip2 files/buffers.
-
-For writing bzip2 files/buffers, see the companion module IO::Compress::Bzip2.
-
-=head1 Functional Interface
-
-A top-level function, C<bunzip2>, is provided to carry out
-"one-shot" uncompression between buffers and/or files. For finer
-control over the uncompression process, see the L</"OO Interface">
-section.
-
- use IO::Uncompress::Bunzip2 qw(bunzip2 $Bunzip2Error) ;
-
- bunzip2 $input => $output [,OPTS]
- or die "bunzip2 failed: $Bunzip2Error\n";
-
-The functional interface needs Perl5.005 or better.
-
-=head2 bunzip2 $input => $output [, OPTS]
-
-C<bunzip2> expects at least two parameters, C<$input> and C<$output>.
-
-=head3 The C<$input> parameter
-
-The parameter, C<$input>, is used to define the source of
-the compressed data.
-
-It can take one of the following forms:
-
-=over 5
-
-=item A filename
-
-If the C<$input> parameter is a simple scalar, it is assumed to be a
-filename. This file will be opened for reading and the input data
-will be read from it.
-
-=item A filehandle
-
-If the C<$input> parameter is a filehandle, the input data will be
-read from it.
-The string '-' can be used as an alias for standard input.
-
-=item A scalar reference
-
-If C<$input> is a scalar reference, the input data will be read
-from C<$$input>.
-
-=item An array reference
-
-If C<$input> is an array reference, each element in the array must be a
-filename.
-
-The input data will be read from each file in turn.
-
-The complete array will be walked to ensure that it only
-contains valid filenames before any data is uncompressed.
-
-=item An Input FileGlob string
-
-If C<$input> is a string that is delimited by the characters "<" and ">"
-C<bunzip2> will assume that it is an I<input fileglob string>. The
-input is the list of files that match the fileglob.
-
-If the fileglob does not match any files ...
-
-See L<File::GlobMapper|File::GlobMapper> for more details.
-
-=back
-
-If the C<$input> parameter is any other type, C<undef> will be returned.
-
-=head3 The C<$output> parameter
-
-The parameter C<$output> is used to control the destination of the
-uncompressed data. This parameter can take one of these forms.
-
-=over 5
-
-=item A filename
-
-If the C<$output> parameter is a simple scalar, it is assumed to be a
-filename. This file will be opened for writing and the uncompressed
-data will be written to it.
-
-=item A filehandle
-
-If the C<$output> parameter is a filehandle, the uncompressed data
-will be written to it.
-The string '-' can be used as an alias for standard output.
-
-=item A scalar reference
-
-If C<$output> is a scalar reference, the uncompressed data will be
-stored in C<$$output>.
-
-=item An Array Reference
-
-If C<$output> is an array reference, the uncompressed data will be
-pushed onto the array.
-
-=item An Output FileGlob
-
-If C<$output> is a string that is delimited by the characters "<" and ">"
-C<bunzip2> will assume that it is an I<output fileglob string>. The
-output is the list of files that match the fileglob.
-
-When C<$output> is an fileglob string, C<$input> must also be a fileglob
-string. Anything else is an error.
-
-=back
-
-If the C<$output> parameter is any other type, C<undef> will be returned.
-
-=head2 Notes
-
-When C<$input> maps to multiple compressed files/buffers and C<$output> is
-a single file/buffer, after uncompression C<$output> will contain a
-concatenation of all the uncompressed data from each of the input
-files/buffers.
-
-=head2 Optional Parameters
-
-Unless specified below, the optional parameters for C<bunzip2>,
-C<OPTS>, are the same as those used with the OO interface defined in the
-L</"Constructor Options"> section below.
-
-=over 5
-
-=item C<< AutoClose => 0|1 >>
-
-This option applies to any input or output data streams to
-C<bunzip2> that are filehandles.
-
-If C<AutoClose> is specified, and the value is true, it will result in all
-input and/or output filehandles being closed once C<bunzip2> has
-completed.
-
-This parameter defaults to 0.
-
-=item C<< BinModeOut => 0|1 >>
-
-When writing to a file or filehandle, set C<binmode> before writing to the
-file.
-
-Defaults to 0.
-
-=item C<< Append => 0|1 >>
-
-TODO
-
-=item C<< MultiStream => 0|1 >>
-
-If the input file/buffer contains multiple compressed data streams, this
-option will uncompress the whole lot as a single data stream.
-
-Defaults to 0.
-
-=item C<< TrailingData => $scalar >>
-
-Returns the data, if any, that is present immediately after the compressed
-data stream once uncompression is complete.
-
-This option can be used when there is useful information immediately
-following the compressed data stream, and you don't know the length of the
-compressed data stream.
-
-If the input is a buffer, C<trailingData> will return everything from the
-end of the compressed data stream to the end of the buffer.
-
-If the input is a filehandle, C<trailingData> will return the data that is
-left in the filehandle input buffer once the end of the compressed data
-stream has been reached. You can then use the filehandle to read the rest
-of the input file.
-
-Don't bother using C<trailingData> if the input is a filename.
-
-If you know the length of the compressed data stream before you start
-uncompressing, you can avoid having to use C<trailingData> by setting the
-C<InputLength> option.
-
-=back
-
-=head2 Examples
-
-To read the contents of the file C<file1.txt.bz2> and write the
-compressed data to the file C<file1.txt>.
-
- use strict ;
- use warnings ;
- use IO::Uncompress::Bunzip2 qw(bunzip2 $Bunzip2Error) ;
-
- my $input = "file1.txt.bz2";
- my $output = "file1.txt";
- bunzip2 $input => $output
- or die "bunzip2 failed: $Bunzip2Error\n";
-
-To read from an existing Perl filehandle, C<$input>, and write the
-uncompressed data to a buffer, C<$buffer>.
-
- use strict ;
- use warnings ;
- use IO::Uncompress::Bunzip2 qw(bunzip2 $Bunzip2Error) ;
- use IO::File ;
-
- my $input = new IO::File "<file1.txt.bz2"
- or die "Cannot open 'file1.txt.bz2': $!\n" ;
- my $buffer ;
- bunzip2 $input => \$buffer
- or die "bunzip2 failed: $Bunzip2Error\n";
-
-To uncompress all files in the directory "/my/home" that match "*.txt.bz2" and store the compressed data in the same directory
-
- use strict ;
- use warnings ;
- use IO::Uncompress::Bunzip2 qw(bunzip2 $Bunzip2Error) ;
-
- bunzip2 '</my/home/*.txt.bz2>' => '</my/home/#1.txt>'
- or die "bunzip2 failed: $Bunzip2Error\n";
-
-and if you want to compress each file one at a time, this will do the trick
-
- use strict ;
- use warnings ;
- use IO::Uncompress::Bunzip2 qw(bunzip2 $Bunzip2Error) ;
-
- for my $input ( glob "/my/home/*.txt.bz2" )
- {
- my $output = $input;
- $output =~ s/.bz2// ;
- bunzip2 $input => $output
- or die "Error compressing '$input': $Bunzip2Error\n";
- }
-
-=head1 OO Interface
-
-=head2 Constructor
-
-The format of the constructor for IO::Uncompress::Bunzip2 is shown below
-
- my $z = new IO::Uncompress::Bunzip2 $input [OPTS]
- or die "IO::Uncompress::Bunzip2 failed: $Bunzip2Error\n";
-
-Returns an C<IO::Uncompress::Bunzip2> object on success and undef on failure.
-The variable C<$Bunzip2Error> will contain an error message on failure.
-
-If you are running Perl 5.005 or better the object, C<$z>, returned from
-IO::Uncompress::Bunzip2 can be used exactly like an L<IO::File|IO::File> filehandle.
-This means that all normal input file operations can be carried out with
-C<$z>. For example, to read a line from a compressed file/buffer you can
-use either of these forms
-
- $line = $z->getline();
- $line = <$z>;
-
-The mandatory parameter C<$input> is used to determine the source of the
-compressed data. This parameter can take one of three forms.
-
-=over 5
-
-=item A filename
-
-If the C<$input> parameter is a scalar, it is assumed to be a filename. This
-file will be opened for reading and the compressed data will be read from it.
-
-=item A filehandle
-
-If the C<$input> parameter is a filehandle, the compressed data will be
-read from it.
-The string '-' can be used as an alias for standard input.
-
-=item A scalar reference
-
-If C<$input> is a scalar reference, the compressed data will be read from
-C<$$output>.
-
-=back
-
-=head2 Constructor Options
-
-The option names defined below are case insensitive and can be optionally
-prefixed by a '-'. So all of the following are valid
-
- -AutoClose
- -autoclose
- AUTOCLOSE
- autoclose
-
-OPTS is a combination of the following options:
-
-=over 5
-
-=item C<< AutoClose => 0|1 >>
-
-This option is only valid when the C<$input> parameter is a filehandle. If
-specified, and the value is true, it will result in the file being closed once
-either the C<close> method is called or the IO::Uncompress::Bunzip2 object is
-destroyed.
-
-This parameter defaults to 0.
-
-=item C<< MultiStream => 0|1 >>
-
-Allows multiple concatenated compressed streams to be treated as a single
-compressed stream. Decompression will stop once either the end of the
-file/buffer is reached, an error is encountered (premature eof, corrupt
-compressed data) or the end of a stream is not immediately followed by the
-start of another stream.
-
-This parameter defaults to 0.
-
-=item C<< Prime => $string >>
-
-This option will uncompress the contents of C<$string> before processing the
-input file/buffer.
-
-This option can be useful when the compressed data is embedded in another
-file/data structure and it is not possible to work out where the compressed
-data begins without having to read the first few bytes. If this is the
-case, the uncompression can be I<primed> with these bytes using this
-option.
-
-=item C<< Transparent => 0|1 >>
-
-If this option is set and the input file/buffer is not compressed data,
-the module will allow reading of it anyway.
-
-In addition, if the input file/buffer does contain compressed data and
-there is non-compressed data immediately following it, setting this option
-will make this module treat the whole file/bufffer as a single data stream.
-
-This option defaults to 1.
-
-=item C<< BlockSize => $num >>
-
-When reading the compressed input data, IO::Uncompress::Bunzip2 will read it in
-blocks of C<$num> bytes.
-
-This option defaults to 4096.
-
-=item C<< InputLength => $size >>
-
-When present this option will limit the number of compressed bytes read
-from the input file/buffer to C<$size>. This option can be used in the
-situation where there is useful data directly after the compressed data
-stream and you know beforehand the exact length of the compressed data
-stream.
-
-This option is mostly used when reading from a filehandle, in which case
-the file pointer will be left pointing to the first byte directly after the
-compressed data stream.
-
-This option defaults to off.
-
-=item C<< Append => 0|1 >>
-
-This option controls what the C<read> method does with uncompressed data.
-
-If set to 1, all uncompressed data will be appended to the output parameter
-of the C<read> method.
-
-If set to 0, the contents of the output parameter of the C<read> method
-will be overwritten by the uncompressed data.
-
-Defaults to 0.
-
-=item C<< Strict => 0|1 >>
-
-This option is a no-op.
-
-=item C<< Small => 0|1 >>
-
-When non-zero this options will make bzip2 use a decompression algorithm
-that uses less memory at the expense of increasing the amount of time
-taken for decompression.
-
-Default is 0.
-
-=back
-
-=head2 Examples
-
-TODO
-
-=head1 Methods
-
-=head2 read
-
-Usage is
-
- $status = $z->read($buffer)
-
-Reads a block of compressed data (the size the the compressed block is
-determined by the C<Buffer> option in the constructor), uncompresses it and
-writes any uncompressed data into C<$buffer>. If the C<Append> parameter is
-set in the constructor, the uncompressed data will be appended to the
-C<$buffer> parameter. Otherwise C<$buffer> will be overwritten.
-
-Returns the number of uncompressed bytes written to C<$buffer>, zero if eof
-or a negative number on error.
-
-=head2 read
-
-Usage is
-
- $status = $z->read($buffer, $length)
- $status = $z->read($buffer, $length, $offset)
-
- $status = read($z, $buffer, $length)
- $status = read($z, $buffer, $length, $offset)
-
-Attempt to read C<$length> bytes of uncompressed data into C<$buffer>.
-
-The main difference between this form of the C<read> method and the
-previous one, is that this one will attempt to return I<exactly> C<$length>
-bytes. The only circumstances that this function will not is if end-of-file
-or an IO error is encountered.
-
-Returns the number of uncompressed bytes written to C<$buffer>, zero if eof
-or a negative number on error.
-
-=head2 getline
-
-Usage is
-
- $line = $z->getline()
- $line = <$z>
-
-Reads a single line.
-
-This method fully supports the use of of the variable C<$/> (or
-C<$INPUT_RECORD_SEPARATOR> or C<$RS> when C<English> is in use) to
-determine what constitutes an end of line. Paragraph mode, record mode and
-file slurp mode are all supported.
-
-=head2 getc
-
-Usage is
-
- $char = $z->getc()
-
-Read a single character.
-
-=head2 ungetc
-
-Usage is
-
- $char = $z->ungetc($string)
-
-=head2 getHeaderInfo
-
-Usage is
-
- $hdr = $z->getHeaderInfo();
- @hdrs = $z->getHeaderInfo();
-
-This method returns either a hash reference (in scalar context) or a list
-or hash references (in array context) that contains information about each
-of the header fields in the compressed data stream(s).
-
-=head2 tell
-
-Usage is
-
- $z->tell()
- tell $z
-
-Returns the uncompressed file offset.
-
-=head2 eof
-
-Usage is
-
- $z->eof();
- eof($z);
-
-Returns true if the end of the compressed input stream has been reached.
-
-=head2 seek
-
- $z->seek($position, $whence);
- seek($z, $position, $whence);
-
-Provides a sub-set of the C<seek> functionality, with the restriction
-that it is only legal to seek forward in the input file/buffer.
-It is a fatal error to attempt to seek backward.
-
-The C<$whence> parameter takes one the usual values, namely SEEK_SET,
-SEEK_CUR or SEEK_END.
-
-Returns 1 on success, 0 on failure.
-
-=head2 binmode
-
-Usage is
-
- $z->binmode
- binmode $z ;
-
-This is a noop provided for completeness.
-
-=head2 opened
-
- $z->opened()
-
-Returns true if the object currently refers to a opened file/buffer.
-
-=head2 autoflush
-
- my $prev = $z->autoflush()
- my $prev = $z->autoflush(EXPR)
-
-If the C<$z> object is associated with a file or a filehandle, this method
-returns the current autoflush setting for the underlying filehandle. If
-C<EXPR> is present, and is non-zero, it will enable flushing after every
-write/print operation.
-
-If C<$z> is associated with a buffer, this method has no effect and always
-returns C<undef>.
-
-B<Note> that the special variable C<$|> B<cannot> be used to set or
-retrieve the autoflush setting.
-
-=head2 input_line_number
-
- $z->input_line_number()
- $z->input_line_number(EXPR)
-
-Returns the current uncompressed line number. If C<EXPR> is present it has
-the effect of setting the line number. Note that setting the line number
-does not change the current position within the file/buffer being read.
-
-The contents of C<$/> are used to to determine what constitutes a line
-terminator.
-
-=head2 fileno
-
- $z->fileno()
- fileno($z)
-
-If the C<$z> object is associated with a file or a filehandle, C<fileno>
-will return the underlying file descriptor. Once the C<close> method is
-called C<fileno> will return C<undef>.
-
-If the C<$z> object is is associated with a buffer, this method will return
-C<undef>.
-
-=head2 close
-
- $z->close() ;
- close $z ;
-
-Closes the output file/buffer.
-
-For most versions of Perl this method will be automatically invoked if
-the IO::Uncompress::Bunzip2 object is destroyed (either explicitly or by the
-variable with the reference to the object going out of scope). The
-exceptions are Perl versions 5.005 through 5.00504 and 5.8.0. In
-these cases, the C<close> method will be called automatically, but
-not until global destruction of all live objects when the program is
-terminating.
-
-Therefore, if you want your scripts to be able to run on all versions
-of Perl, you should call C<close> explicitly and not rely on automatic
-closing.
-
-Returns true on success, otherwise 0.
-
-If the C<AutoClose> option has been enabled when the IO::Uncompress::Bunzip2
-object was created, and the object is associated with a file, the
-underlying file will also be closed.
-
-=head2 nextStream
-
-Usage is
-
- my $status = $z->nextStream();
-
-Skips to the next compressed data stream in the input file/buffer. If a new
-compressed data stream is found, the eof marker will be cleared and C<$.>
-will be reset to 0.
-
-Returns 1 if a new stream was found, 0 if none was found, and -1 if an
-error was encountered.
-
-=head2 trailingData
-
-Usage is
-
- my $data = $z->trailingData();
-
-Returns the data, if any, that is present immediately after the compressed
-data stream once uncompression is complete. It only makes sense to call
-this method once the end of the compressed data stream has been
-encountered.
-
-This option can be used when there is useful information immediately
-following the compressed data stream, and you don't know the length of the
-compressed data stream.
-
-If the input is a buffer, C<trailingData> will return everything from the
-end of the compressed data stream to the end of the buffer.
-
-If the input is a filehandle, C<trailingData> will return the data that is
-left in the filehandle input buffer once the end of the compressed data
-stream has been reached. You can then use the filehandle to read the rest
-of the input file.
-
-Don't bother using C<trailingData> if the input is a filename.
-
-If you know the length of the compressed data stream before you start
-uncompressing, you can avoid having to use C<trailingData> by setting the
-C<InputLength> option in the constructor.
-
-=head1 Importing
-
-No symbolic constants are required by this IO::Uncompress::Bunzip2 at present.
-
-=over 5
-
-=item :all
-
-Imports C<bunzip2> and C<$Bunzip2Error>.
-Same as doing this
-
- use IO::Uncompress::Bunzip2 qw(bunzip2 $Bunzip2Error) ;
-
-=back
-
-=head1 EXAMPLES
-
-=head2 Working with Net::FTP
-
-See L<IO::Uncompress::Bunzip2::FAQ|IO::Uncompress::Bunzip2::FAQ/"Compressed files and Net::FTP">
-
-=head1 SEE ALSO
-
-L<Compress::Zlib>, L<IO::Compress::Gzip>, L<IO::Uncompress::Gunzip>, L<IO::Compress::Deflate>, L<IO::Uncompress::Inflate>, L<IO::Compress::RawDeflate>, L<IO::Uncompress::RawInflate>, L<IO::Compress::Bzip2>, L<IO::Compress::Lzop>, L<IO::Uncompress::UnLzop>, L<IO::Compress::Lzf>, L<IO::Uncompress::UnLzf>, L<IO::Uncompress::AnyInflate>, L<IO::Uncompress::AnyUncompress>
-
-L<Compress::Zlib::FAQ|Compress::Zlib::FAQ>
-
-L<File::GlobMapper|File::GlobMapper>, L<Archive::Zip|Archive::Zip>,
-L<Archive::Tar|Archive::Tar>,
-L<IO::Zlib|IO::Zlib>
-
-The primary site for the bzip2 program is F<http://www.bzip.org>.
-
-See the module L<Compress::Bzip2|Compress::Bzip2>
-
-=head1 AUTHOR
-
-This module was written by Paul Marquess, F<pmqs@cpan.org>.
-
-=head1 MODIFICATION HISTORY
-
-See the Changes file.
-
-=head1 COPYRIGHT AND LICENSE
-
-Copyright (c) 2005-2008 Paul Marquess. All rights reserved.
-
-This program is free software; you can redistribute it and/or
-modify it under the same terms as Perl itself.
-
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/IPC/Run3.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/IPC/Run3.pm
deleted file mode 100644
index 47712f4d0b4..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/IPC/Run3.pm
+++ /dev/null
@@ -1,814 +0,0 @@
-package IPC::Run3;
-
-=head1 NAME
-
-IPC::Run3 - run a subprocess with input/ouput redirection
-
-=head1 VERSION
-
-version 0.040
-
-=cut
-
-$VERSION = '0.040';
-
-=head1 SYNOPSIS
-
- use IPC::Run3; # Exports run3() by default
-
- run3 \@cmd, \$in, \$out, \$err;
-
-=head1 DESCRIPTION
-
-This module allows you to run a subprocess and redirect stdin, stdout,
-and/or stderr to files and perl data structures. It aims to satisfy 99% of the
-need for using C<system>, C<qx>, and C<open3>
-with a simple, extremely Perlish API.
-
-Speed, simplicity, and portability are paramount. (That's speed of Perl code;
-which is often much slower than the kind of buffered I/O that this module uses
-to spool input to and output from the child command.)
-
-=cut
-
-use 5.006_000; # i.e. v5.6.0
-
-@EXPORT = qw( run3 );
-%EXPORT_TAGS = ( all => \@EXPORT );
-@ISA = qw( Exporter );
-use Exporter;
-
-use strict;
-use constant debugging => $ENV{IPCRUN3DEBUG} || $ENV{IPCRUNDEBUG} || 0;
-use constant profiling => $ENV{IPCRUN3PROFILE} || $ENV{IPCRUNPROFILE} || 0;
-use constant is_win32 => 0 <= index $^O, "Win32";
-
-BEGIN {
- if ( is_win32 ) {
- eval "use Win32 qw( GetOSName ); 1" or die $@;
- }
-}
-
-#use constant is_win2k => is_win32 && GetOSName() =~ /Win2000/i;
-#use constant is_winXP => is_win32 && GetOSName() =~ /WinXP/i;
-
-use Carp qw( croak );
-use File::Temp qw( tempfile );
-use POSIX qw( dup dup2 );
-
-# We cache the handles of our temp files in order to
-# keep from having to incur the (largish) overhead of File::Temp
-my %fh_cache;
-my $fh_cache_pid = $$;
-
-my $profiler;
-
-sub _profiler { $profiler } # test suite access
-
-BEGIN {
- if ( profiling ) {
- eval "use Time::HiRes qw( gettimeofday ); 1" or die $@;
- if ( $ENV{IPCRUN3PROFILE} =~ /\A\d+\z/ ) {
- require IPC::Run3::ProfPP;
- IPC::Run3::ProfPP->import;
- $profiler = IPC::Run3::ProfPP->new(Level => $ENV{IPCRUN3PROFILE});
- } else {
- my ( $dest, undef, $class ) =
- reverse split /(=)/, $ENV{IPCRUN3PROFILE}, 2;
- $class = "IPC::Run3::ProfLogger"
- unless defined $class && length $class;
- if ( not eval "require $class" ) {
- my $e = $@;
- $class = "IPC::Run3::$class";
- eval "require IPC::Run3::$class" or die $e;
- }
- $profiler = $class->new( Destination => $dest );
- }
- $profiler->app_call( [ $0, @ARGV ], scalar gettimeofday() );
- }
-}
-
-
-END {
- $profiler->app_exit( scalar gettimeofday() ) if profiling;
-}
-
-sub _spool_data_to_child {
- my ( $type, $source, $binmode_it ) = @_;
-
- # If undef (not \undef) passed, they want the child to inherit
- # the parent's STDIN.
- return undef unless defined $source;
- warn "binmode()ing STDIN\n" if is_win32 && debugging && $binmode_it;
-
- my $fh;
- if ( ! $type ) {
- open $fh, "<", $source or croak "$!: $source";
- if ( is_win32 ) {
- binmode $fh, ":raw"; # Remove all layers
- binmode $fh, ":crlf" unless $binmode_it;
- }
- warn "run3(): feeding file '$source' to child STDIN\n"
- if debugging >= 2;
- } elsif ( $type eq "FH" ) {
- $fh = $source;
- warn "run3(): feeding filehandle '$source' to child STDIN\n"
- if debugging >= 2;
- } else {
- $fh = $fh_cache{in} ||= tempfile;
- truncate $fh, 0;
- seek $fh, 0, 0;
- if ( is_win32 ) {
- binmode $fh, ":raw"; # Remove any previous layers
- binmode $fh, ":crlf" unless $binmode_it;
- }
- my $seekit;
- if ( $type eq "SCALAR" ) {
-
- # When the run3()'s caller asks to feed an empty file
- # to the child's stdin, we want to pass a live file
- # descriptor to an empty file (like /dev/null) so that
- # they don't get surprised by invalid fd errors and get
- # normal EOF behaviors.
- return $fh unless defined $$source; # \undef passed
-
- warn "run3(): feeding SCALAR to child STDIN",
- debugging >= 3
- ? ( ": '", $$source, "' (", length $$source, " chars)" )
- : (),
- "\n"
- if debugging >= 2;
-
- $seekit = length $$source;
- print $fh $$source or die "$! writing to temp file";
-
- } elsif ( $type eq "ARRAY" ) {
- warn "run3(): feeding ARRAY to child STDIN",
- debugging >= 3 ? ( ": '", @$source, "'" ) : (),
- "\n"
- if debugging >= 2;
-
- print $fh @$source or die "$! writing to temp file";
- $seekit = grep length, @$source;
- } elsif ( $type eq "CODE" ) {
- warn "run3(): feeding output of CODE ref '$source' to child STDIN\n"
- if debugging >= 2;
- my $parms = []; # TODO: get these from $options
- while (1) {
- my $data = $source->( @$parms );
- last unless defined $data;
- print $fh $data or die "$! writing to temp file";
- $seekit = length $data;
- }
- }
-
- seek $fh, 0, 0 or croak "$! seeking on temp file for child's stdin"
- if $seekit;
- }
-
- croak "run3() can't redirect $type to child stdin"
- unless defined $fh;
-
- return $fh;
-}
-
-sub _fh_for_child_output {
- my ( $what, $type, $dest, $options ) = @_;
-
- my $fh;
- if ( $type eq "SCALAR" && $dest == \undef ) {
- warn "run3(): redirecting child $what to oblivion\n"
- if debugging >= 2;
-
- $fh = $fh_cache{nul} ||= do {
- open $fh, ">", File::Spec->devnull;
- $fh;
- };
- } elsif ( $type eq "FH" ) {
- $fh = $dest;
- warn "run3(): redirecting $what to filehandle '$dest'\n"
- if debugging >= 3;
- } elsif ( !$type ) {
- warn "run3(): feeding child $what to file '$dest'\n"
- if debugging >= 2;
-
- open $fh, $options->{"append_$what"} ? ">>" : ">", $dest
- or croak "$!: $dest";
- } else {
- warn "run3(): capturing child $what\n"
- if debugging >= 2;
-
- $fh = $fh_cache{$what} ||= tempfile;
- seek $fh, 0, 0;
- truncate $fh, 0;
- }
-
- if ( is_win32 ) {
- warn "binmode()ing $what\n" if debugging && $options->{"binmode_$what"};
- binmode $fh, ":raw";
- binmode $fh, ":crlf" unless $options->{"binmode_$what"};
- }
- return $fh;
-}
-
-sub _read_child_output_fh {
- my ( $what, $type, $dest, $fh, $options ) = @_;
-
- return if $type eq "SCALAR" && $dest == \undef;
-
- seek $fh, 0, 0 or croak "$! seeking on temp file for child $what";
-
- if ( $type eq "SCALAR" ) {
- warn "run3(): reading child $what to SCALAR\n"
- if debugging >= 3;
-
- # two read()s are used instead of 1 so that the first will be
- # logged even it reads 0 bytes; the second won't.
- my $count = read $fh, $$dest, 10_000,
- $options->{"append_$what"} ? length $$dest : 0;
- while (1) {
- croak "$! reading child $what from temp file"
- unless defined $count;
-
- last unless $count;
-
- warn "run3(): read $count bytes from child $what",
- debugging >= 3 ? ( ": '", substr( $$dest, -$count ), "'" ) : (),
- "\n"
- if debugging >= 2;
-
- $count = read $fh, $$dest, 10_000, length $$dest;
- }
- } elsif ( $type eq "ARRAY" ) {
- if ($options->{"append_$what"}) {
- push @$dest, <$fh>;
- } else {
- @$dest = <$fh>;
- }
- if ( debugging >= 2 ) {
- my $count = 0;
- $count += length for @$dest;
- warn
- "run3(): read ",
- scalar @$dest,
- " records, $count bytes from child $what",
- debugging >= 3 ? ( ": '", @$dest, "'" ) : (),
- "\n";
- }
- } elsif ( $type eq "CODE" ) {
- warn "run3(): capturing child $what to CODE ref\n"
- if debugging >= 3;
-
- local $_;
- while ( <$fh> ) {
- warn
- "run3(): read ",
- length,
- " bytes from child $what",
- debugging >= 3 ? ( ": '", $_, "'" ) : (),
- "\n"
- if debugging >= 2;
-
- $dest->( $_ );
- }
- } else {
- croak "run3() can't redirect child $what to a $type";
- }
-
-}
-
-sub _type {
- my ( $redir ) = @_;
- return "FH" if eval { $redir->isa("IO::Handle") };
- my $type = ref $redir;
- return $type eq "GLOB" ? "FH" : $type;
-}
-
-sub _max_fd {
- my $fd = dup(0);
- POSIX::close $fd;
- return $fd;
-}
-
-my $run_call_time;
-my $sys_call_time;
-my $sys_exit_time;
-
-sub run3 {
- $run_call_time = gettimeofday() if profiling;
-
- my $options = @_ && ref $_[-1] eq "HASH" ? pop : {};
-
- my ( $cmd, $stdin, $stdout, $stderr ) = @_;
-
- print STDERR "run3(): running ",
- join( " ", map "'$_'", ref $cmd ? @$cmd : $cmd ),
- "\n"
- if debugging;
-
- if ( ref $cmd ) {
- croak "run3(): empty command" unless @$cmd;
- croak "run3(): undefined command" unless defined $cmd->[0];
- croak "run3(): command name ('')" unless length $cmd->[0];
- } else {
- croak "run3(): missing command" unless @_;
- croak "run3(): undefined command" unless defined $cmd;
- croak "run3(): command ('')" unless length $cmd;
- }
-
- my $in_type = _type $stdin;
- my $out_type = _type $stdout;
- my $err_type = _type $stderr;
-
- if ($fh_cache_pid != $$) {
- # fork detected, close all cached filehandles and clear the cache
- close $_ foreach values %fh_cache;
- %fh_cache = ();
- $fh_cache_pid = $$;
- }
-
- # This routine procedes in stages so that a failure in an early
- # stage prevents later stages from running, and thus from needing
- # cleanup.
-
- my $in_fh = _spool_data_to_child $in_type, $stdin,
- $options->{binmode_stdin} if defined $stdin;
-
- my $out_fh = _fh_for_child_output "stdout", $out_type, $stdout,
- $options if defined $stdout;
-
- my $tie_err_to_out =
- defined $stderr && defined $stdout && $stderr eq $stdout;
-
- my $err_fh = $tie_err_to_out
- ? $out_fh
- : _fh_for_child_output "stderr", $err_type, $stderr,
- $options if defined $stderr;
-
- # this should make perl close these on exceptions
- local *STDIN_SAVE;
- local *STDOUT_SAVE;
- local *STDERR_SAVE;
-
- my $saved_fd0 = dup( 0 ) if defined $in_fh;
-
-# open STDIN_SAVE, "<&STDIN"# or croak "run3(): $! saving STDIN"
-# if defined $in_fh;
- open STDOUT_SAVE, ">&STDOUT" or croak "run3(): $! saving STDOUT"
- if defined $out_fh;
- open STDERR_SAVE, ">&STDERR" or croak "run3(): $! saving STDERR"
- if defined $err_fh;
-
- my $ok = eval {
- # The open() call here seems to not force fd 0 in some cases;
- # I ran in to trouble when using this in VCP, not sure why.
- # the dup2() seems to work.
- dup2( fileno $in_fh, 0 )
-# open STDIN, "<&=" . fileno $in_fh
- or croak "run3(): $! redirecting STDIN"
- if defined $in_fh;
-
-# close $in_fh or croak "$! closing STDIN temp file"
-# if ref $stdin;
-
- open STDOUT, ">&" . fileno $out_fh
- or croak "run3(): $! redirecting STDOUT"
- if defined $out_fh;
-
- open STDERR, ">&" . fileno $err_fh
- or croak "run3(): $! redirecting STDERR"
- if defined $err_fh;
-
- $sys_call_time = gettimeofday() if profiling;
-
- my $r = ref $cmd
- ? system { $cmd->[0] }
- is_win32
- ? map {
- # Probably need to offer a win32 escaping
- # option, every command may be different.
- ( my $s = $_ ) =~ s/"/"""/g;
- $s = qq{"$s"};
- $s;
- } @$cmd
- : @$cmd
- : system $cmd;
-
- $sys_exit_time = gettimeofday() if profiling;
-
- unless ( defined $r && $r != -1 ) {
- if ( debugging ) {
- my $err_fh = defined $err_fh ? \*STDERR_SAVE : \*STDERR;
- print $err_fh "run3(): system() error $!\n"
- }
- die $!;
- }
-
- if ( debugging ) {
- my $err_fh = defined $err_fh ? \*STDERR_SAVE : \*STDERR;
- print $err_fh "run3(): \$? is $?\n"
- }
- 1;
- };
- my $x = $@;
-
- my @errs;
-
- if ( defined $saved_fd0 ) {
- dup2( $saved_fd0, 0 );
- POSIX::close( $saved_fd0 );
- }
-
-# open STDIN, "<&STDIN_SAVE"# or push @errs, "run3(): $! restoring STDIN"
-# if defined $in_fh;
- open STDOUT, ">&STDOUT_SAVE" or push @errs, "run3(): $! restoring STDOUT"
- if defined $out_fh;
- open STDERR, ">&STDERR_SAVE" or push @errs, "run3(): $! restoring STDERR"
- if defined $err_fh;
-
- croak join ", ", @errs if @errs;
-
- die $x unless $ok;
-
- _read_child_output_fh "stdout", $out_type, $stdout, $out_fh, $options
- if defined $out_fh && $out_type && $out_type ne "FH";
- _read_child_output_fh "stderr", $err_type, $stderr, $err_fh, $options
- if defined $err_fh && $err_type && $err_type ne "FH" && !$tie_err_to_out;
- $profiler->run_exit(
- $cmd,
- $run_call_time,
- $sys_call_time,
- $sys_exit_time,
- scalar gettimeofday()
- ) if profiling;
-
- return 1;
-}
-
-1;
-
-__END__
-
-=head2 C<< run3($cmd, $stdin, $stdout, $stderr, \%options) >>
-
-All parameters after C<$cmd> are optional.
-
-The parameters C<$stdin>, C<$stdout> and C<$stderr> indicate
-how the child's corresponding filehandle
-(C<STDIN>, C<STDOUT> and C<STDERR>, resp.) will be redirected.
-Because the redirects come last, this allows C<STDOUT> and C<STDERR> to default
-to the parent's by just not specifying them -- a common use case.
-
-C<run3> returns true if the command executes and throws an exception otherwise.
-It leaves C<$?> intact for inspection of exit and wait status.
-
-=head3 C<$cmd>
-
-Usually C<$cmd> will be an ARRAY reference and the child is invoked via
-
- system @$cmd;
-
-But C<$cmd> may also be a string in which case the child is invoked via
-
- system $cmd;
-
-(cf. L<perlfunc/system> for the difference and the pitfalls of using
-the latter form).
-
-=head3 C<$stdin>, C<$stdout>, C<$stderr>
-
-The parameters C<$stdin>, C<$stdout> and C<$stderr>
-can take one of the following forms:
-
-=over 4
-
-=item C<undef> (or not specified at all)
-
-The child inherits the corresponding filehandle from the parent.
-
- run3 \@cmd, $stdin; # child writes to same STDOUT and STDERR as parent
- run3 \@cmd, undef, $stdout, $stderr; # child reads from same STDIN as parent
-
-=item C<\undef>
-
-The child's filehandle is redirected from or to the
-local equivalent of C</dev/null> (as returned by
-C<< File::Spec->devnull() >>).
-
- run3 \@cmd, \undef, $stdout, $stderr; # child reads from /dev/null
-
-=item a simple scalar
-
-The parameter is taken to be the name of a file to read from
-or write to. In the latter case, the file will be opened via
-
- open FH, ">", ...
-
-i.e. it is created if it doesn't exist and truncated otherwise.
-Note that the file is opened by the parent which will L<croak|Carp/croak>
-in case of failure.
-
- run3 \@cmd, \undef, "out.txt"; # child writes to file "out.txt"
-
-=item a filehandle (either a reference to a GLOB or an C<IO::Handle>)
-
-The filehandle is inherited by the child.
-
- open my $fh, ">", "out.txt";
- print $fh "prologue\n";
- ...
- run3 \@cmd, \undef, $fh; # child writes to $fh
- ...
- print $fh "epilogue\n";
- close $fh;
-
-=item a SCALAR reference
-
-The referenced scalar is treated as a string to be read from or
-written to. In the latter case, the previous content of the string
-is overwritten.
-
- my $out;
- run3 \@cmd, \undef, \$out; # child writes into string
- run3 \@cmd, \<<EOF; # child reads from string (can use "here" notation)
- Input
- to
- child
- EOF
-
-=item an ARRAY reference
-
-For C<$stdin>, the elements of C<@$stdin> are simply spooled to the child.
-
-For C<$stdout> or C<$stderr>, the child's corresponding file descriptor
-is read line by line (as determined by the current setting of C<$/>)
-into C<@$stdout> or C<@$stderr>, resp. The previous content of the array
-is overwritten.
-
- my @lines;
- run3 \@cmd, \undef, \@lines; # child writes into array
-
-=item a CODE reference
-
-For C<$stdin>, C<&$stdin> will be called repeatedly (with no arguments) and
-the return values are spooled to the child. C<&$stdin> must signal the end of
-input by returning C<undef>.
-
-For C<$stdout> or C<$stderr>, the child's corresponding file descriptor
-is read line by line (as determined by the current setting of C<$/>)
-and C<&$stdout> or C<&$stderr>, resp., is called with the contents of the line.
-Note that there's no end-of-file indication.
-
- my $i = 0;
- sub producer {
- return $i < 10 ? "line".$i++."\n" : undef;
- }
-
- run3 \@cmd, \&producer; # child reads 10 lines
-
-Note that this form of redirecting the child's I/O doesn't imply
-any form of concurrency between parent and child - run3()'s method of
-operation is the same no matter which form of redirection you specify.
-
-=back
-
-If the same value is passed for C<$stdout> and C<$stderr>, then the child
-will write both C<STDOUT> and C<STDERR> to the same filehandle.
-In general, this means that
-
- run3 \@cmd, \undef, "foo.txt", "foo.txt";
- run3 \@cmd, \undef, \$both, \$both;
-
-will DWIM and pass a single file handle to the child for both C<STDOUT> and
-C<STDERR>, collecting all into file "foo.txt" or C<$both>.
-
-=head3 C<\%options>
-
-The last parameter, C<\%options>, must be a hash reference if present.
-
-Currently the following
-keys are supported:
-
-=over 4
-
-=item C<binmode_stdin>, C<binmode_stdout>, C<binmode_stderr>
-
-If their value is true then the corresponding
-parameter C<$stdin>, C<$stdout> or C<$stderr>, resp., operates
-in "binary" mode (cf. L<perlfunc/binmode>).
-The default is to operate in "text" mode.
-(This is only relevant for platforms where these modes differ.)
-
-=item C<append_stdout>, C<append_stderr>
-
-If their value is true then the corresponding
-parameter C<$stdout> or C<$stderr>, resp., will append the child's output
-to the existing "contents" of the redirector. This only makes
-sense if the redirector is a simple scalar (the corresponding file
-is opened in append mode), a SCALAR reference (the output is
-appended to the previous contents of the string)
-or an ARRAY reference (the output is C<push>ed onto the
-previous contents of the array).
-
-=back
-
-=head1 HOW IT WORKS
-
-=over 4
-
-=item (1)
-
-For each redirector C<$stdin>, C<$stdout>, and C<$stderr>,
-C<run3()> furnishes a filehandle:
-
-=over 4
-
-=item *
-
-if the redirector already specifies a filehandle it just uses that
-
-=item *
-
-if the redirector specifies a filename, C<run3()> opens the file
-in the appropriate mode
-
-=item *
-
-in all other cases, C<run3()> opens a temporary file
-(using L<tempfile|Temp/tempfile>)
-
-=back
-
-=item (2)
-
-If C<run3()> opened a temporary file for C<$stdin> in step (1),
-it writes the data using the specified method (either
-from a string, an array or returnd by a function) to the temporary file and rewinds it.
-
-=item (3)
-
-C<run3()> saves the parent's C<STDIN>, C<STDOUT> and C<STDERR> by duplicating
-them to new filehandles. It duplicates the filehandles from step (1)
-to C<STDIN>, C<STDOUT> and C<STDERR>, resp.
-
-=item (4)
-
-C<run3()> runs the child by invoking L<system|perlfunc/system>
-with C<$cmd> as specified above.
-
-=item (5)
-
-C<run3()> restores the parent's C<STDIN>, C<STDOUT> and C<STDERR> saved in step (3).
-
-=item (6)
-
-If C<run3()> opened a temporary file for C<$stdout> or C<$stderr> in step (1),
-it rewinds it and reads back its contents using the specified method
-(either to a string, an array or by calling a function).
-
-=item (7)
-
-C<run3()> closes all filehandles that it opened explicitly in step (1).
-
-=back
-
-Note that when using temporary files, C<run3()> tries to amortize the overhead
-by reusing them (i.e. it keeps them open and rewinds and truncates them
-before the next operation).
-
-=head1 LIMITATIONS
-
-Often uses intermediate files (determined by File::Temp, and thus by the
-File::Spec defaults and the TMPDIR env. variable) for speed, portability and
-simplicity.
-
-Use extrem caution when using C<run3> in a threaded environment if
-concurrent calls of C<run3> are possible. Most likely, I/O from different
-invocations will get mixed up. The reason is that in most thread
-implementations all threads in a process share the same STDIN/STDOUT/STDERR.
-Known failures are Perl ithreads on Linux and Win32. Note that C<fork>
-on Win32 is emulated via Win32 threads and hence I/O mix up is possible
-between forked children here (C<run3> is "fork safe" on Unix, though).
-
-=head1 DEBUGGING
-
-To enable debugging use the IPCRUN3DEBUG environment variable to
-a non-zero integer value:
-
- $ IPCRUN3DEBUG=1 myapp
-
-=head1 PROFILING
-
-To enable profiling, set IPCRUN3PROFILE to a number to enable emitting profile
-information to STDERR (1 to get timestamps, 2 to get a summary report at the
-END of the program, 3 to get mini reports after each run) or to a filename to
-emit raw data to a file for later analysis.
-
-=head1 COMPARISON
-
-Here's how it stacks up to existing APIs:
-
-=head2 compared to C<system()>, C<qx''>, C<open "...|">, C<open "|...">
-
-=over
-
-=item +
-
-redirects more than one file descriptor
-
-=item +
-
-returns TRUE on success, FALSE on failure
-
-=item +
-
-throws an error if problems occur in the parent process (or the pre-exec child)
-
-=item +
-
-allows a very perlish interface to Perl data structures and subroutines
-
-=item +
-
-allows 1 word invocations to avoid the shell easily:
-
- run3 ["foo"]; # does not invoke shell
-
-=item -
-
-does not return the exit code, leaves it in $?
-
-=back
-
-=head2 compared to C<open2()>, C<open3()>
-
-=over
-
-=item +
-
-no lengthy, error prone polling/select loop needed
-
-=item +
-
-hides OS dependancies
-
-=item +
-
-allows SCALAR, ARRAY, and CODE references to source and sink I/O
-
-=item +
-
-I/O parameter order is like C<open3()> (not like C<open2()>).
-
-=item -
-
-does not allow interaction with the subprocess
-
-=back
-
-=head2 compared to L<IPC::Run::run()|IPC::Run/run>
-
-=over
-
-=item +
-
-smaller, lower overhead, simpler, more portable
-
-=item +
-
-no select() loop portability issues
-
-=item +
-
-does not fall prey to Perl closure leaks
-
-=item -
-
-does not allow interaction with the subprocess (which
-IPC::Run::run() allows by redirecting subroutines)
-
-=item -
-
-lacks many features of C<IPC::Run::run()> (filters, pipes,
-redirects, pty support)
-
-=back
-
-=head1 COPYRIGHT
-
-Copyright 2003, R. Barrie Slaymaker, Jr., All Rights Reserved
-
-=head1 LICENSE
-
-You may use this module under the terms of the BSD, Artistic, or GPL licenses,
-any version.
-
-=head1 AUTHOR
-
-Barrie Slaymaker E<lt>C<barries@slaysys.com>E<gt>
-
-Ricardo SIGNES E<lt>C<rjbs@cpan.org>E<gt> performed some routine maintenance in
-2005, thanks to help from the following ticket and/or patch submitters: Jody
-Belka, Roderich Schupp, David Morel, and anonymous others.
-
-=cut
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/IPC/Run3/ProfArrayBuffer.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/IPC/Run3/ProfArrayBuffer.pm
deleted file mode 100644
index a638848a105..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/IPC/Run3/ProfArrayBuffer.pm
+++ /dev/null
@@ -1,86 +0,0 @@
-package IPC::Run3::ProfArrayBuffer;
-
-$VERSION = 0.038;
-
-=head1 NAME
-
-IPC::Run3::ProfArrayBuffer - Store profile events in RAM in an array
-
-=head1 SYNOPSIS
-
-=head1 DESCRIPTION
-
-=cut
-
-use strict;
-
-=head1 METHODS
-
-=over
-
-=item C<< IPC::Run3::ProfArrayBuffer->new() >>
-
-=cut
-
-sub new {
- my $class = ref $_[0] ? ref shift : shift;
-
- my $self = bless { @_ }, $class;
-
- $self->{Events} = [];
-
- return $self;
-}
-
-=item C<< $buffer->app_call(@events) >>
-
-=item C<< $buffer->app_exit(@events) >>
-
-=item C<< $buffer->run_exit(@events) >>
-
-The three above methods push the given events onto the stack of recorded
-events.
-
-=cut
-
-for my $subname ( qw(app_call app_exit run_exit) ) {
- no strict 'refs';
- *{$subname} = sub {
- push @{shift->{Events}}, [ $subname => @_ ];
- };
-}
-
-=item get_events
-
-Returns a list of all the events. Each event is an ARRAY reference
-like:
-
- [ "app_call", 1.1, ... ];
-
-=cut
-
-sub get_events {
- my $self = shift;
- @{$self->{Events}};
-}
-
-=back
-
-=head1 LIMITATIONS
-
-=head1 COPYRIGHT
-
-Copyright 2003, R. Barrie Slaymaker, Jr., All Rights Reserved
-
-=head1 LICENSE
-
-You may use this module under the terms of the BSD, Artistic, or GPL licenses,
-any version.
-
-=head1 AUTHOR
-
-Barrie Slaymaker E<lt>barries@slaysys.comE<gt>
-
-=cut
-
-1;
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/IPC/Run3/ProfLogReader.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/IPC/Run3/ProfLogReader.pm
deleted file mode 100644
index 2852dd491e2..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/IPC/Run3/ProfLogReader.pm
+++ /dev/null
@@ -1,157 +0,0 @@
-package IPC::Run3::ProfLogReader;
-
-$VERSION = 0.038;
-
-=head1 NAME
-
-IPC::Run3::ProfLogReader - read and process a ProfLogger file
-
-=head1 SYNOPSIS
-
- use IPC::Run3::ProfLogReader;
-
- my $reader = IPC::Run3::ProfLogReader->new; ## use "run3.out"
- my $reader = IPC::Run3::ProfLogReader->new( Source => $fn );
-
- my $profiler = IPC::Run3::ProfPP; ## For example
- my $reader = IPC::Run3::ProfLogReader->new( ..., Handler => $p );
-
- $reader->read;
- $eaderr->read_all;
-
-=head1 DESCRIPTION
-
-Reads a log file. Use the filename "-" to read from STDIN.
-
-=cut
-
-use strict;
-
-=head1 METHODS
-
-=head2 C<< IPC::Run3::ProfLogReader->new( ... ) >>
-
-=cut
-
-sub new {
- my $class = ref $_[0] ? ref shift : shift;
- my $self = bless { @_ }, $class;
-
- $self->{Source} = "run3.out"
- unless defined $self->{Source} && length $self->{Source};
-
- my $source = $self->{Source};
-
- if ( ref $source eq "GLOB" || UNIVERSAL::isa( $source, "IO::Handle" ) ) {
- $self->{FH} = $source;
- }
- elsif ( $source eq "-" ) {
- $self->{FH} = \*STDIN;
- }
- else {
- open PROFILE, "<$self->{Source}" or die "$!: $self->{Source}\n";
- $self->{FH} = *PROFILE{IO};
- }
- return $self;
-}
-
-
-=head2 C<< $reader->set_handler( $handler ) >>
-
-=cut
-
-sub set_handler { $_[0]->{Handler} = $_[1] }
-
-=head2 C<< $reader->get_handler() >>
-
-=cut
-
-sub get_handler { $_[0]->{Handler} }
-
-=head2 C<< $reader->read() >>
-
-=cut
-
-sub read {
- my $self = shift;
-
- my $fh = $self->{FH};
- my @ln = split / /, <$fh>;
-
- return 0 unless @ln;
- return 1 unless $self->{Handler};
-
- chomp $ln[-1];
-
- ## Ignore blank and comment lines.
- return 1 if @ln == 1 && ! length $ln[0] || 0 == index $ln[0], "#";
-
- if ( $ln[0] eq "\\app_call" ) {
- shift @ln;
- my @times = split /,/, pop @ln;
- $self->{Handler}->app_call(
- [
- map {
- s/\\\\/\\/g;
- s/\\_/ /g;
- $_;
- } @ln
- ],
- @times
- );
- }
- elsif ( $ln[0] eq "\\app_exit" ) {
- shift @ln;
- $self->{Handler}->app_exit( pop @ln, @ln );
- }
- else {
- my @times = split /,/, pop @ln;
- $self->{Handler}->run_exit(
- [
- map {
- s/\\\\/\\/g;
- s/\\_/ /g;
- $_;
- } @ln
- ],
- @times
- );
- }
-
- return 1;
-}
-
-
-=head2 C<< $reader->read_all() >>
-
-This method reads until there is nothing left to read, and then returns true.
-
-=cut
-
-sub read_all {
- my $self = shift;
-
- 1 while $self->read;
-
- return 1;
-}
-
-
-=head1 LIMITATIONS
-
-=head1 COPYRIGHT
-
- Copyright 2003, R. Barrie Slaymaker, Jr., All Rights Reserved
-
-=head1 LICENSE
-
-You may use this module under the terms of the BSD, Artistic, or GPL licenses,
-any version.
-
-=head1 AUTHOR
-
-Barrie Slaymaker E<lt>barries@slaysys.comE<gt>
-
-=cut
-
-1;
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/IPC/Run3/ProfLogger.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/IPC/Run3/ProfLogger.pm
deleted file mode 100644
index 291c7b3d6b3..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/IPC/Run3/ProfLogger.pm
+++ /dev/null
@@ -1,139 +0,0 @@
-package IPC::Run3::ProfLogger;
-
-$VERSION = 0.038;
-
-=head1 NAME
-
-IPC::Run3::ProfLogger - write profiling data to a log file
-
-=head1 SYNOPSIS
-
- use IPC::Run3::ProfLogger;
-
- my $logger = IPC::Run3::ProfLogger->new; ## write to "run3.out"
- my $logger = IPC::Run3::ProfLogger->new( Destination => $fn );
-
- $logger->app_call( \@cmd, $time );
-
- $logger->run_exit( \@cmd1, @times1 );
- $logger->run_exit( \@cmd1, @times1 );
-
- $logger->app_exit( $time );
-
-=head1 DESCRIPTION
-
-Used by IPC::Run3 to write a profiling log file. Does not
-generate reports or maintain statistics; its meant to have minimal
-overhead.
-
-Its API is compatible with a tiny subset of the other IPC::Run profiling
-classes.
-
-=cut
-
-use strict;
-
-=head1 METHODS
-
-=head2 C<< IPC::Run3::ProfLogger->new( ... ) >>
-
-=cut
-
-sub new {
- my $class = ref $_[0] ? ref shift : shift;
- my $self = bless { @_ }, $class;
-
- $self->{Destination} = "run3.out"
- unless defined $self->{Destination} && length $self->{Destination};
-
- open PROFILE, ">$self->{Destination}"
- or die "$!: $self->{Destination}\n";
- binmode PROFILE;
- $self->{FH} = *PROFILE{IO};
-
- $self->{times} = [];
- return $self;
-}
-
-=head2 C<< $logger->run_exit( ... ) >>
-
-=cut
-
-sub run_exit {
- my $self = shift;
- my $fh = $self->{FH};
- print( $fh
- join(
- " ",
- (
- map {
- my $s = $_;
- $s =~ s/\\/\\\\/g;
- $s =~ s/ /_/g;
- $s;
- } @{shift()}
- ),
- join(
- ",",
- @{$self->{times}},
- @_,
- ),
- ),
- "\n"
- );
-}
-
-=head2 C<< $logger->app_exit( $arg ) >>
-
-=cut
-
-sub app_exit {
- my $self = shift;
- my $fh = $self->{FH};
- print $fh "\\app_exit ", shift, "\n";
-}
-
-=head2 C<< $logger->app_call( $t, @args) >>
-
-=cut
-
-sub app_call {
- my $self = shift;
- my $fh = $self->{FH};
- my $t = shift;
- print( $fh
- join(
- " ",
- "\\app_call",
- (
- map {
- my $s = $_;
- $s =~ s/\\\\/\\/g;
- $s =~ s/ /\\_/g;
- $s;
- } @_
- ),
- $t,
- ),
- "\n"
- );
-}
-
-=head1 LIMITATIONS
-
-=head1 COPYRIGHT
-
-Copyright 2003, R. Barrie Slaymaker, Jr., All Rights Reserved
-
-=head1 LICENSE
-
-You may use this module under the terms of the BSD, Artistic, or GPL licenses,
-any version.
-
-=head1 AUTHOR
-
-Barrie Slaymaker E<lt>barries@slaysys.comE<gt>
-
-=cut
-
-1;
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/IPC/Run3/ProfPP.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/IPC/Run3/ProfPP.pm
deleted file mode 100644
index 2d2c2b215ac..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/IPC/Run3/ProfPP.pm
+++ /dev/null
@@ -1,156 +0,0 @@
-package IPC::Run3::ProfPP;
-
-$VERSION = 0.000_1;
-
-=head1 NAME
-
-IPC::Run3::ProfPP - Generate reports from IPC::Run3 profiling data
-
-=head1 SYNOPSIS
-
-=head1 DESCRIPTION
-
-Used by IPC::Run3 and/or run3profpp to print out profiling reports for
-human readers. Use other classes for extracting data in other ways.
-
-The output methods are plain text, override these (see the source for
-now) to provide other formats.
-
-This class generates reports on each run3_exit() and app_exit() call.
-
-=cut
-
-require IPC::Run3::ProfReporter;
-@ISA = qw( IPC::Run3::ProfReporter );
-
-use strict;
-use POSIX qw( floor );
-
-=head1 METHODS
-
-=head2 C<< IPC::Run3::ProfPP->new() >>
-
-Returns a new profile reporting object.
-
-=cut
-
-sub _emit { shift; warn @_ }
-
-sub _t {
- sprintf "%10.6f secs", @_;
-}
-
-sub _r {
- my ( $num, $denom ) = @_;
- return () unless $denom;
- sprintf "%10.6f", $num / $denom;
-}
-
-sub _pct {
- my ( $num, $denom ) = @_;
- return () unless $denom;
- sprintf " (%3d%%)", floor( 100 * $num / $denom + 0.5 );
-}
-
-=head2 C<< $profpp->handle_app_call() >>
-
-=cut
-
-sub handle_app_call {
- my $self = shift;
- $self->_emit("IPC::Run3 parent: ",
- join( " ", @{$self->get_app_cmd} ),
- "\n",
- );
-
- $self->{NeedNL} = 1;
-}
-
-=head2 C<< $profpp->handle_app_exit() >>
-
-=cut
-
-sub handle_app_exit {
- my $self = shift;
-
- $self->_emit("\n") if $self->{NeedNL} && $self->{NeedNL} != 1;
-
- $self->_emit( "IPC::Run3 total elapsed: ",
- _t( $self->get_app_cumulative_time ),
- "\n");
- $self->_emit( "IPC::Run3 calls to run3(): ",
- sprintf( "%10d", $self->get_run_count ),
- "\n");
- $self->_emit( "IPC::Run3 total spent in run3(): ",
- _t( $self->get_run_cumulative_time ),
- _pct( $self->get_run_cumulative_time, $self->get_app_cumulative_time ),
- ", ",
- _r( $self->get_run_cumulative_time, $self->get_run_count ),
- " per call",
- "\n");
- my $exclusive =
- $self->get_app_cumulative_time - $self->get_run_cumulative_time;
- $self->_emit( "IPC::Run3 total spent not in run3(): ",
- _t( $exclusive ),
- _pct( $exclusive, $self->get_app_cumulative_time ),
- "\n");
- $self->_emit( "IPC::Run3 total spent in children: ",
- _t( $self->get_sys_cumulative_time ),
- _pct( $self->get_sys_cumulative_time, $self->get_app_cumulative_time ),
- ", ",
- _r( $self->get_sys_cumulative_time, $self->get_run_count ),
- " per call",
- "\n");
- my $overhead =
- $self->get_run_cumulative_time - $self->get_sys_cumulative_time;
- $self->_emit( "IPC::Run3 total overhead: ",
- _t( $overhead ),
- _pct(
- $overhead,
- $self->get_sys_cumulative_time
- ),
- ", ",
- _r( $overhead, $self->get_run_count ),
- " per call",
- "\n");
-}
-
-=head2 C<< $profpp->handle_run_exit() >>
-
-=cut
-
-sub handle_run_exit {
- my $self = shift;
- my $overhead = $self->get_run_time - $self->get_sys_time;
-
- $self->_emit("\n") if $self->{NeedNL} && $self->{NeedNL} != 2;
- $self->{NeedNL} = 3;
-
- $self->_emit( "IPC::Run3 child: ",
- join( " ", @{$self->get_run_cmd} ),
- "\n");
- $self->_emit( "IPC::Run3 run3() : ", _t( $self->get_run_time ), "\n",
- "IPC::Run3 child : ", _t( $self->get_sys_time ), "\n",
- "IPC::Run3 overhead: ", _t( $overhead ),
- _pct( $overhead, $self->get_sys_time ),
- "\n");
-}
-
-=head1 LIMITATIONS
-
-=head1 COPYRIGHT
-
- Copyright 2003, R. Barrie Slaymaker, Jr., All Rights Reserved
-
-=head1 LICENSE
-
-You may use this module under the terms of the BSD, Artistic, or GPL licenses,
-any version.
-
-=head1 AUTHOR
-
-Barrie Slaymaker E<lt>barries@slaysys.comE<gt>
-
-=cut
-
-1;
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/IPC/Run3/ProfReporter.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/IPC/Run3/ProfReporter.pm
deleted file mode 100644
index 84f5270a875..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/IPC/Run3/ProfReporter.pm
+++ /dev/null
@@ -1,256 +0,0 @@
-package IPC::Run3::ProfReporter;
-
-$VERSION = 0.000_1;
-
-=head1 NAME
-
-IPC::Run3::ProfReporter - base class for handling profiling data
-
-=head1 SYNOPSIS
-
-=head1 DESCRIPTION
-
-See L<IPC::Run3::ProfPP|IPC::Run3::ProfPP> and for an example subclass.
-
-This class just notes and accumulates times; subclasses use methods like
-"handle_app_call", "handle_run_exit" and "handle_app_exit" to emit reports on
-it. The default methods for these handlers are noops.
-
-If run from the command line, a reporter will be created and run on
-each logfile given as a command line parameter or on run3.out if none
-are given.
-
-This allows reports to be run like:
-
- perl -MIPC::Run3::ProfPP -e1
- perl -MIPC::Run3::ProfPP -e1 foo.out bar.out
-
-Use "-" to read from STDIN (the log file format is meant to be moderately
-greppable):
-
- grep "^cvs " run3.out perl -MIPC::Run3::ProfPP -e1 -
-
-Use --app to show only application level statistics (ie don't emit
-a report section for each command run).
-
-=cut
-
-use strict;
-
-my $loaded_by;
-
-sub import {
- $loaded_by = shift;
-}
-
-END {
- my @caller;
- for ( my $i = 0;; ++$i ) {
- my @c = caller $i;
- last unless @c;
- @caller = @c;
- }
-
- if ( $caller[0] eq "main"
- && $caller[1] eq "-e"
- ) {
- require IPC::Run3::ProfLogReader;
- require Getopt::Long;
- my ( $app, $run );
-
- Getopt::Long::GetOptions(
- "app" => \$app,
- "run" => \$run,
- );
-
- $app = 1, $run = 1 unless $app || $run;
-
- for ( @ARGV ? @ARGV : "" ) {
- my $r = IPC::Run3::ProfLogReader->new(
- Source => $_,
- Handler => $loaded_by->new(
- Source => $_,
- app_report => $app,
- run_report => $run,
- ),
- );
- $r->read_all;
- }
- }
-}
-
-=head1 METHODS
-
-=over
-
-=item C<< IPC::Run3::ProfReporter->new >>
-
-Returns a new profile reporting object.
-
-=cut
-
-sub new {
- my $class = ref $_[0] ? ref shift : shift;
- my $self = bless { @_ }, $class;
- $self->{app_report} = 1, $self->{run_report} = 1
- unless $self->{app_report} || $self->{run_report};
-
- return $self;
-}
-
-=item C<< $reporter->handle_app_call( ... ) >>
-
-=item C<< $reporter->handle_app_exit( ... ) >>
-
-=item C<< $reporter->handle_run_exit( ... ) >>
-
-These methods are called by the handled events (see below).
-
-=cut
-
-sub handle_app_call {}
-sub handle_app_exit {}
-
-sub handle_run_exit {}
-
-=item C<< $reporter->app_call(\@cmd, $time) >>
-
-=item C<< $reporter->app_exit($time) >>
-
-=item C<< $reporter->run_exit(@times) >>
-
- $self->app_call( $time );
- my $time = $self->get_app_call_time;
-
-Sets the time (in floating point seconds) when the application, run3(),
-or system() was called or exited. If no time parameter is passed, uses
-IPC::Run3's time routine.
-
-Use get_...() to retrieve these values (and _accum values, too). This
-is a separate method to speed the execution time of the setters just a
-bit.
-
-=cut
-
-sub app_call {
- my $self = shift;
- ( $self->{app_cmd}, $self->{app_call_time} ) = @_;
- $self->handle_app_call if $self->{app_report};
-}
-
-sub app_exit {
- my $self = shift;
- $self->{app_exit_time} = shift;
- $self->handle_app_exit if $self->{app_report};
-}
-
-sub run_exit {
- my $self = shift;
- @{$self}{qw(
- run_cmd run_call_time sys_call_time sys_exit_time run_exit_time
- )} = @_;
-
- ++$self->{run_count};
- $self->{run_cumulative_time} += $self->get_run_time;
- $self->{sys_cumulative_time} += $self->get_sys_time;
- $self->handle_run_exit if $self->{run_report};
-}
-
-=item C<< $reporter->get_run_count() >>
-
-=item C<< $reporter->get_app_call_time() >>
-
-=item C<< $reporter->get_app_exit_time() >>
-
-=item C<< $reporter->get_app_cmd() >>
-
-=item C<< $reporter->get_app_time() >>
-
-=cut
-
-sub get_run_count { shift->{run_count} }
-sub get_app_call_time { shift->{app_call_time} }
-sub get_app_exit_time { shift->{app_exit_time} }
-sub get_app_cmd { shift->{app_cmd} }
-sub get_app_time {
- my $self = shift;
- $self->get_app_exit_time - $self->get_app_call_time;
-}
-
-=item C<< $reporter->get_app_cumulative_time() >>
-
-=cut
-
-sub get_app_cumulative_time {
- my $self = shift;
- $self->get_app_exit_time - $self->get_app_call_time;
-}
-
-=item C<< $reporter->get_run_call_time() >>
-
-=item C<< $reporter->get_run_exit_time() >>
-
-=item C<< $reporter->get_run_time() >>
-
-=cut
-
-sub get_run_call_time { shift->{run_call_time} }
-sub get_run_exit_time { shift->{run_exit_time} }
-sub get_run_time {
- my $self = shift;
- $self->get_run_exit_time - $self->get_run_call_time;
-}
-
-=item C<< $reporter->get_run_cumulative_time() >>
-
-=cut
-
-sub get_run_cumulative_time { shift->{run_cumulative_time} }
-
-=item C<< $reporter->get_sys_call_time() >>
-
-=item C<< $reporter->get_sys_exit_time() >>
-
-=item C<< $reporter->get_sys_time() >>
-
-=cut
-
-sub get_sys_call_time { shift->{sys_call_time} }
-sub get_sys_exit_time { shift->{sys_exit_time} }
-sub get_sys_time {
- my $self = shift;
- $self->get_sys_exit_time - $self->get_sys_call_time;
-}
-
-=item C<< $reporter->get_sys_cumulative_time() >>
-
-=cut
-
-sub get_sys_cumulative_time { shift->{sys_cumulative_time} }
-
-=item C<< $reporter->get_run_cmd() >>
-
-=cut
-
-sub get_run_cmd { shift->{run_cmd} }
-
-=back
-
-=head1 LIMITATIONS
-
-=head1 COPYRIGHT
-
- Copyright 2003, R. Barrie Slaymaker, Jr., All Rights Reserved
-
-=head1 LICENSE
-
-You may use this module under the terms of the BSD, Artistic, or GPL licenses,
-any version.
-
-=head1 AUTHOR
-
-Barrie Slaymaker <barries@slaysys.com>
-
-=cut
-
-1;
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/LWP.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/LWP.pm
deleted file mode 100644
index b1d400c237e..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/LWP.pm
+++ /dev/null
@@ -1,655 +0,0 @@
-package LWP;
-
-$VERSION = "5.813";
-sub Version { $VERSION; }
-
-require 5.005;
-require LWP::UserAgent; # this should load everything you need
-
-1;
-
-__END__
-
-=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 http, https, gopher, ftp, news,
-file, and 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/pub/WWW/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 C<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 C<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 *
-
-The 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 *
-
-The 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 *
-
-The B<headers> contain additional information about the
-request and can also used to describe the content. The headers
-are a set of keyword/value pairs.
-
-=item *
-
-The B<content> is an arbitrary amount of data.
-
-=back
-
-=head2 The Response Object
-
-The libwww-perl response object has the class name C<HTTP::Response>.
-The main attributes of objects of this class are:
-
-=over 3
-
-=item *
-
-The B<code> is a numerical value that indicates the overall
-outcome of the request.
-
-=item *
-
-The B<message> is a short, human readable string that
-corresponds to the I<code>.
-
-=item *
-
-The B<headers> contain additional information about the
-response and describe the content.
-
-=item *
-
-The 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 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 C<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 C<HTTP::Request> object as
-argument and (eventually) returns a C<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 *
-
-The B<timeout> specifies how much time we give remote servers to
-respond before the library disconnects and creates an
-internal I<timeout> response.
-
-=item *
-
-The B<agent> specifies the name that your application should use when it
-presents itself on the network.
-
-=item *
-
-The B<from> attribute 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 *
-
-The B<parse_head> specifies whether we should initialize response
-headers from the E<lt>head> section of HTML documents.
-
-=item *
-
-The B<proxy> and B<no_proxy> attributes specify if and when to go through
-a proxy server. <URL:http://www.w3.org/pub/WWW/Proxies/>
-
-=item *
-
-The B<credentials> provide 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
-C<LWP::UserAgent>. The library includes a
-sub-class, C<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;
- $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 C<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 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 the 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::Debug -- Debug logging module
- 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 I<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 C<lwp-request>, C<lwp-rget> and C<lwp-mirror>
-are implemented.
-
-=head1 ENVIRONMENT
-
-The following environment variables are used by LWP:
-
-=over
-
-=item HOME
-
-The C<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_USE_HTTP_10
-
-Enable the old HTTP/1.0 protocol driver instead of the new HTTP/1.1
-driver. You might want to set this to a TRUE value if you discover
-that your old LWP applications fails after you installed LWP-5.60 or
-better.
-
-=item PERL_HTTP_URI_CLASS
-
-Used to decide what URI objects to instantiate. The default is C<URI>.
-You might want to set it to C<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 GuentherDaniel 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-2008, 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://gitorious.org/projects/libwww-perl
-
-The best place to discuss this code is on the <libwww@perl.org>
-mailing list.
-
-=cut
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/LWP/Authen/Basic.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/LWP/Authen/Basic.pm
deleted file mode 100644
index f4c5f4982be..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/LWP/Authen/Basic.pm
+++ /dev/null
@@ -1,36 +0,0 @@
-package LWP::Authen::Basic;
-use strict;
-
-require MIME::Base64;
-
-sub authenticate
-{
- my($class, $ua, $proxy, $auth_param, $response,
- $request, $arg, $size) = @_;
-
- my($user, $pass) = $ua->get_basic_credentials($auth_param->{realm},
- $request->url, $proxy);
- return $response unless defined $user and defined $pass;
-
- my $auth_header = $proxy ? "Proxy-Authorization" : "Authorization";
- my $auth_value = "Basic " . MIME::Base64::encode("$user:$pass", "");
-
- # Need to check this isn't a repeated fail!
- my $r = $response;
- while ($r) {
- my $auth = $r->request->header($auth_header);
- if ($auth && $auth eq $auth_value) {
- # 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);
-}
-
-1;
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/LWP/Authen/Digest.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/LWP/Authen/Digest.pm
deleted file mode 100644
index 0fd3ca6acff..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/LWP/Authen/Digest.pm
+++ /dev/null
@@ -1,90 +0,0 @@
-package LWP::Authen::Digest;
-use strict;
-
-require Digest::MD5;
-
-sub authenticate
-{
- my($class, $ua, $proxy, $auth_param, $response,
- $request, $arg, $size) = @_;
-
- my($user, $pass) = $ua->get_basic_credentials($auth_param->{realm},
- $request->url, $proxy);
- return $response unless defined $user and defined $pass;
-
- my $nc = sprintf "%08X", ++$ua->{authen_md5_nonce_count}{$auth_param->{nonce}};
- my $cnonce = sprintf "%8x", time;
-
- my $uri = $request->url->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{$_};
- push(@pairs, "$_=" . qq("$resp{$_}"));
- }
-
- my $auth_header = $proxy ? "Proxy-Authorization" : "Authorization";
- my $auth_value = "Digest " . join(", ", @pairs);
-
- # Need to check this isn't a repeated fail!
- my $r = $response;
- while ($r) {
- my $u = $r->request->{digest_user_pass};
- if ($u && $u->[0] eq $user && $u->[1] eq $pass) {
- # 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);
- # we shouldn't really do this, but...
- $referral->{digest_user_pass} = [$user, $pass];
-
- return $ua->request($referral, $arg, $size, $response);
-}
-
-1;
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/LWP/Authen/Ntlm.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/LWP/Authen/Ntlm.pm
deleted file mode 100644
index be79f8a1ab0..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/LWP/Authen/Ntlm.pm
+++ /dev/null
@@ -1,195 +0,0 @@
-package LWP::Authen::Ntlm;
-
-use strict;
-use vars qw/$VERSION/;
-
-$VERSION = '5.810';
-
-use Authen::NTLM "1.02";
-use MIME::Base64 "2.12";
-
-sub authenticate {
- LWP::Debug::debug("authenticate() has been called");
- my($class, $ua, $proxy, $auth_param, $response,
- $request, $arg, $size) = @_;
-
- my($user, $pass) = $ua->get_basic_credentials($auth_param->{realm},
- $request->url, $proxy);
-
- unless(defined $user and defined $pass) {
- LWP::Debug::debug("No username and password available from get_basic_credentials(). Returning unmodified response object");
- return $response;
- }
-
- if (!$ua->conn_cache()) {
- LWP::Debug::debug("Keep alive not enabled, emitting a warning");
- 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
- LWP::Debug::debug("In first phase of NTLM authentication");
- 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);
- LWP::Debug::debug("Returning response object with auth header:\n$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
- LWP::Debug::debug("In second phase of NTLM authentication");
- my $auth_value;
- if ($response->code ne '401') {
- LWP::Debug::debug("Response from server was not 401 Unauthorized, returning response object without auth headers");
- 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);
- LWP::Debug::debug("Returning response object with auth header:\n$auth_header $auth_value");
- my $response2 = $ua->request($referral, $arg, $size, $response);
- return $response2;
- }
-}
-
-1;
-
-
-=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 = new LWP::UserAgent(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
-
-C<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 = new LWP::UserAgent(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
-
-If you run into trouble and need help troubleshooting your problems, try enabling LWP
-debugging by putting this line at the top of your code:
-
- use LWP::Debug qw(+);
-
-You should get copious debugging output, including messages from LWP::Authen::Ntlm itself.
-
-=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>.
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/LWP/ConnCache.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/LWP/ConnCache.pm
deleted file mode 100644
index 6ac55cedd40..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/LWP/ConnCache.pm
+++ /dev/null
@@ -1,310 +0,0 @@
-package LWP::ConnCache;
-
-use strict;
-use vars qw($VERSION $DEBUG);
-
-$VERSION = "5.810";
-
-
-sub new {
- my($class, %cnf) = @_;
- my $total_capacity = delete $cnf{total_capacity};
- $total_capacity = 1 unless defined $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__
-
-=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 LWP::UserAgent.
-
-The following basic methods are provided:
-
-=over
-
-=item $cache = LWP::ConnCache->new( %options )
-
-This method constructs a new C<LWP::ConnCache> object. The only
-option currently accepted is 'total_capacity'. If specified it
-initialize the total_capacity option. It defaults to the value 1.
-
-=item $cache->total_capacity( [$num_connections] )
-
-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.
-
-=item $cache->capacity($type, [$num_connections] )
-
-Get/set a limit for the number of connections of the specified type
-that can be cached. The $type will typically be a short string like
-"http" or "ftp".
-
-=item $cache->drop( [$checker, [$reason]] )
-
-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 $reason argument is passed on to the dropped() method.
-
-=item $cache->prune
-
-Calling this method will drop all connections that are dead. This is
-tested by calling the ping() method on the connections. If the ping()
-method exists and returns a FALSE value, then the connection is
-dropped.
-
-=item $cache->get_types
-
-This returns all the 'type' fields used for the currently cached
-connections.
-
-=item $cache->get_connections( [$type] )
-
-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.
-
-=back
-
-
-The following methods are called by low-level protocol modules to
-try to save away connections and to get them back.
-
-=over
-
-=item $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 added.
-
-=item $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.
-
-=back
-
-The following methods are called internally. Subclasses might want to
-override them.
-
-=over
-
-=item $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.
-
-=item $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
-$LWP::ConnCache::DEBUG variable is set and nothing more.
-
-=back
-
-=head1 SUBCLASSING
-
-For specialized cache policy it makes sense to subclass
-C<LWP::ConnCache> and perhaps override the deposit(), enforce_limits()
-and 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.
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/LWP/Debug.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/LWP/Debug.pm
deleted file mode 100644
index 826bafaa451..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/LWP/Debug.pm
+++ /dev/null
@@ -1,134 +0,0 @@
-package LWP::Debug;
-
-require Exporter;
-@ISA = qw(Exporter);
-@EXPORT_OK = qw(level trace debug conns);
-
-use Carp ();
-
-my @levels = qw(trace debug conns);
-%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__
-
-=head1 NAME
-
-LWP::Debug - debug routines for the libwww-perl library
-
-=head1 SYNOPSIS
-
- use LWP::Debug qw(+ -conns);
-
- # Used internally in the library
- LWP::Debug::trace('send()');
- LWP::Debug::debug('url ok');
- LWP::Debug::conns("read $n bytes: $data");
-
-=head1 DESCRIPTION
-
-LWP::Debug provides tracing facilities. The trace(), debug() and
-conns() function are called within the library and they log
-information at increasing levels of detail. Which level of detail is
-actually printed is controlled with the C<level()> function.
-
-The following functions are available:
-
-=over 4
-
-=item level(...)
-
-The C<level()> function controls the level of detail being
-logged. Passing '+' or '-' indicates full and no logging
-respectively. Individual levels can switched on and of by passing the
-name of the level with a '+' or '-' prepended. The levels are:
-
- trace : trace function calls
- debug : print debug messages
- conns : show all data transfered over the connections
-
-The LWP::Debug module provide a special import() method that allows
-you to pass the level() arguments with initial use statement. If a
-use argument start with '+' or '-' then it is passed to the level
-function, else the name is exported as usual. The following two
-statements are thus equivalent (if you ignore that the second pollutes
-your namespace):
-
- use LWP::Debug qw(+);
- use LWP::Debug qw(level); level('+');
-
-=item trace($msg)
-
-The C<trace()> function is used for tracing function
-calls. The package and calling subroutine name is
-printed along with the passed argument. This should
-be called at the start of every major function.
-
-=item debug($msg)
-
-The C<debug()> function is used for high-granularity
-reporting of state in functions.
-
-=item conns($msg)
-
-The C<conns()> function is used to show data being
-transferred over the connections. This may generate
-considerable output.
-
-=back
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/LWP/DebugFile.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/LWP/DebugFile.pm
deleted file mode 100644
index 015682c96bb..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/LWP/DebugFile.pm
+++ /dev/null
@@ -1,220 +0,0 @@
-package LWP::DebugFile;
-
-use strict;
-use LWP::Debug ();
-
-use vars qw($outname $outpath @ISA $last_message_time);
-@ISA = ('LWP::Debug');
-
-_init() unless $^C or !caller;
-$LWP::Debug::current_level{'conns'} = 1;
-
-
-
-sub _init {
- $outpath = $ENV{'LWPDEBUGPATH'} || ''
- unless defined $outpath;
- $outname = $ENV{'LWPDEBUGFILE'} ||
- sprintf "%slwp_%x_%x.log", $outpath, $^T,
- defined( &Win32::GetTickCount )
- ? (Win32::GetTickCount() & 0xFFFF)
- : $$
- # Using $$ under Win32 isn't nice, because the OS usually
- # reuses the $$ value almost immediately!! So the lower
- # 16 bits of the uptime tick count is a great substitute.
- unless defined $outname;
-
- open LWPERR, ">>$outname" or die "Can't write-open $outname: $!";
- # binmode(LWPERR);
- {
- no strict;
- my $x = select(LWPERR);
- ++$|;
- select($x);
- }
-
- $last_message_time = time();
- die "Can't print to LWPERR"
- unless print LWPERR "\n# ", __PACKAGE__, " logging to $outname\n";
- # check at least the first print, just for sanity's sake!
-
- print LWPERR "# Time now: \{$last_message_time\} = ",
- scalar(localtime($last_message_time)), "\n";
-
- LWP::Debug::level($ENV{'LWPDEBUGLEVEL'} || '+');
- return;
-}
-
-
-BEGIN { # So we don't get redefinition warnings...
- undef &LWP::Debug::conns;
- undef &LWP::Debug::_log;
-}
-
-
-sub LWP::Debug::conns {
- if($LWP::Debug::current_level{'conns'}) {
- my $msg = $_[0];
- my $line;
- my $prefix = '0';
- while($msg =~ m/([^\n\r]*[\n\r]*)/g) {
- next unless length($line = $1);
- # Hex escape it:
- $line =~ s/([^\x20\x21\x23-\x7a\x7c\x7e])/
- (ord($1)<256) ? sprintf('\x%02X',ord($1))
- : sprintf('\x{%x}',ord($1))
- /eg;
- LWP::Debug::_log("S>$prefix \"$line\"");
- $prefix = '+';
- }
- }
-}
-
-
-sub LWP::Debug::_log
-{
- my $msg = shift;
- $msg .= "\n" unless $msg =~ /\n$/; # ensure trailing "\n"
-
- my($package,$filename,$line,$sub) = caller(2);
- unless((my $this_time = time()) == $last_message_time) {
- print LWPERR "# Time now: \{$this_time\} = ",
- scalar(localtime($this_time)), "\n";
- $last_message_time = $this_time;
- }
- print LWPERR "$sub: $msg";
-}
-
-
-1;
-
-__END__
-
-=head1 NAME
-
-LWP::DebugFile - routines for tracing/debugging LWP
-
-=head1 SYNOPSIS
-
-If you want to see just what LWP is doing when your program calls it,
-add this to the beginning of your program's source:
-
- use LWP::DebugFile;
-
-For even more verbose debug output, do this instead:
-
- use LWP::DebugFile ('+');
-
-=head1 DESCRIPTION
-
-This module is like LWP::Debug in that it allows you to see what your
-calls to LWP are doing behind the scenes. But it is unlike
-L<LWP::Debug|LWP::Debug> in that it sends the output to a file, instead
-of to STDERR (as LWP::Debug does).
-
-=head1 OPTIONS
-
-The options you can use in C<use LWP::DebugFile (I<options>)> are the
-same as the B<non-exporting> options available from C<use LWP::Debug
-(I<options>)>. That is, you can do things like this:
-
- use LWP::DebugFile qw(+);
- use LWP::Debug qw(+ -conns);
- use LWP::Debug qw(trace);
-
-The meanings of these are explained in the
-L<documentation for LWP::Debug|LWP::Debug>.
-The only differences are that by default, LWP::DebugFile has C<cons>
-debugging on, ad that (as mentioned earlier), only C<non-exporting>
-options are available. That is, you B<can't> do this:
-
- use LWP::DebugFile qw(trace); # wrong
-
-You might expect that to export LWP::Debug's C<trace()> function,
-but it doesn't work -- it's a compile-time error.
-
-=head1 OUTPUT FILE NAMING
-
-If you don't do anything, the output file (where all the LWP debug/trace
-output goes) will be in the current directory, and will be named like
-F<lwp_3db7aede_b93.log>, where I<3db7aede> is C<$^T> expressed in hex,
-and C<b93> is C<$$> expressed in hex. Presumably this is a
-unique-for-all-time filename!
-
-If you don't want the files to go in the current directory, you
-can set C<$LWP::DebugFile::outpath> before you load the LWP::DebugFile
-module:
-
- BEGIN { $LWP::DebugFile::outpath = '/tmp/crunk/' }
- use LWP::DebugFile;
-
-Note that you must end the value with a path separator ("/" in this
-case -- under MacPerl it would be ":"). With that set, you will
-have output files named like F</tmp/crunk/lwp_3db7aede_b93.log>.
-
-If you want the LWP::DebugFile output to go a specific filespec (instead
-of just a uniquely named file, in whatever directory), instead set the
-variable C<$LWP::DebugFile::outname>, like so:
-
- BEGIN { $LWP::DebugFile::outname = '/home/mojojojo/lwp.log' }
- use LWP::DebugFile;
-
-In that case, C<$LWP::DebugFile::outpath> isn't consulted at all, and
-output is always written to the file F</home/mojojojo/lwp.log>.
-
-Note that the value of C<$LWP::DebugFile::outname> doesn't need to
-be an absolute filespec. You can do this:
-
- BEGIN { $LWP::DebugFile::outname = 'lwp.log' }
- use LWP::DebugFile;
-
-In that case, output goes to a file named F<lwp.log> in the current
-directory -- specifically, whatever directory is current when
-LWP::DebugFile is first loaded. C<$LWP::DebugFile::outpath> is still not
-consulted -- its value is used only if C<$LWP::DebugFile::outname>
-isn't set.
-
-
-=head1 ENVIRONMENT
-
-If you set the environment variables C<LWPDEBUGPATH> or
-C<LWPDEBUGFILE>, their values will be used in initializing the
-values of C<$LWP::DebugFile::outpath>
-and C<$LWP::DebugFile::outname>.
-
-That is, if you have C<LWPDEBUGFILE> set to F</home/mojojojo/lwp.log>,
-then you can just start out your program with:
-
- use LWP::DebugFile;
-
-and it will act as if you had started it like this:
-
- BEGIN { $LWP::DebugFile::outname = '/home/mojojojo/lwp.log' }
- use LWP::DebugFile;
-
-=head1 IMPLEMENTATION NOTES
-
-This module works by subclassing C<LWP::Debug>, (notably inheriting its
-C<import>). It also redefines C<&LWP::Debug::conns> and
-C<&LWP::Debug::_log> to make for output that is a little more verbose,
-and friendlier for when you're looking at it later in a log file.
-
-=head1 SEE ALSO
-
-L<LWP::Debug>
-
-=head1 COPYRIGHT AND DISCLAIMERS
-
-Copyright (c) 2002 Sean M. Burke.
-
-This library 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.
-
-=head1 AUTHOR
-
-Sean M. Burke C<sburke@cpan.org>
-
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/LWP/MediaTypes.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/LWP/MediaTypes.pm
deleted file mode 100644
index 8bdfe709eb3..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/LWP/MediaTypes.pm
+++ /dev/null
@@ -1,299 +0,0 @@
-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 = "5.810";
-
-require LWP::Debug;
-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 _dump {
- require Data::Dumper;
- Data::Dumper->new([\%suffixType, \%suffixExt, \%suffixEncoding],
- [qw(*suffixType *suffixExt *suffixEncoding)])->Dump;
-}
-
-
-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{$_[0]};
- }
- my(@type) = @_;
- my(@suffix, $ext, $type);
- foreach (@type) {
- if (s/\*/.*/) {
- while(($ext,$type) = each(%suffixType)) {
- push(@suffix, $ext) if $type =~ /^$_$/;
- }
- }
- else {
- while(($ext,$type) = each(%suffixType)) {
- push(@suffix, $ext) if $type eq $_;
- }
- }
- }
- 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{$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 = ();
- if($^O eq "MacOS") {
- push(@priv_files, "$ENV{HOME}:media.types", "$ENV{HOME}:mime.types")
- if defined $ENV{HOME}; # Some does not have a home (for instance Win32)
- }
- else {
- 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) {
- if($^O eq "MacOS") {
- @files = map {$_."LWP:media.types"} @INC;
- }
- else {
- @files = map {"$_/LWP/media.types"} @INC;
- }
- push @files, @priv_files;
- }
- for $typefile (@files) {
- local(*TYPE);
- open(TYPE, $typefile) || next;
- LWP::Debug::debug("Reading media types from $typefile");
- 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/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/LWP/MemberMixin.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/LWP/MemberMixin.pm
deleted file mode 100644
index e5ee6f6382e..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/LWP/MemberMixin.pm
+++ /dev/null
@@ -1,44 +0,0 @@
-package LWP::MemberMixin;
-
-sub _elem
-{
- my $self = shift;
- my $elem = shift;
- my $old = $self->{$elem};
- $self->{$elem} = shift if @_;
- return $old;
-}
-
-1;
-
-__END__
-
-=head1 NAME
-
-LWP::MemberMixin - Member access mixin class
-
-=head1 SYNOPSIS
-
- package Foo;
- require LWP::MemberMixin;
- @ISA=qw(LWP::MemberMixin);
-
-=head1 DESCRIPTION
-
-A mixin class to get methods that provide easy access to member
-variables in the %$self.
-Ideally there should be better Perl language support for this.
-
-There is only one method provided:
-
-=over 4
-
-=item _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.
-
-=back
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/LWP/Protocol.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/LWP/Protocol.pm
deleted file mode 100644
index b40d3d4ecda..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/LWP/Protocol.pm
+++ /dev/null
@@ -1,290 +0,0 @@
-package LWP::Protocol;
-
-require LWP::MemberMixin;
-@ISA = qw(LWP::MemberMixin);
-$VERSION = "5.810";
-
-use strict;
-use Carp ();
-use HTTP::Status ();
-use HTTP::Response;
-
-my %ImplementedBy = (); # scheme => classname
-
-
-
-sub new
-{
- my($class, $scheme, $ua) = @_;
-
- my $self = bless {
- scheme => $scheme,
- ua => $ua,
-
- # historical/redundant
- parse_head => $ua->{parse_head},
- 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 =~ s/[.+\-]/_/g; # 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
- eval "require $ic";
- if ($@) {
- if ($@ =~ /Can't locate/) { #' #emacs get confused by '
- $ic = '';
- }
- else {
- die "$@\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 parse_head { shift->_elem('parse_head', @_); }
-sub max_size { shift->_elem('max_size', @_); }
-
-
-sub collect
-{
- my ($self, $arg, $response, $collector) = @_;
- my $content;
- my($ua, $parse_head, $max_size) = @{$self}{qw(ua parse_head max_size)};
-
- my $parser;
- if ($parse_head && $response->_is_html) {
- require HTML::HeadParser;
- $parser = HTML::HeadParser->new($response->{'_headers'});
- $parser->xml_mode(1) if $response->_is_xhtml;
- $parser->utf8_mode(1) if $] >= 5.008 && $HTML::Parser::VERSION >= 3.40;
- }
- my $content_size = 0;
- my $length = $response->content_length;
-
- if (!defined($arg) || !$response->is_success) {
- # scalar
- while ($content = &$collector, length $$content) {
- if ($parser) {
- $parser->parse($$content) or undef($parser);
- }
- LWP::Debug::debug("read " . length($$content) . " bytes");
- $response->add_content($$content);
- $content_size += length($$content);
- $ua->progress(($length ? ($content_size / $length) : "tick"), $response);
- if (defined($max_size) && $content_size > $max_size) {
- LWP::Debug::debug("Aborting because size limit exceeded");
- $response->push_header("Client-Aborted", "max_size");
- last;
- }
- }
- }
- elsif (!ref($arg)) {
- # filename
- open(OUT, ">$arg") or
- return HTTP::Response->new(&HTTP::Status::RC_INTERNAL_SERVER_ERROR,
- "Cannot write to '$arg': $!");
- binmode(OUT);
- local($\) = ""; # ensure standard $OUTPUT_RECORD_SEPARATOR
- while ($content = &$collector, length $$content) {
- if ($parser) {
- $parser->parse($$content) or undef($parser);
- }
- LWP::Debug::debug("read " . length($$content) . " bytes");
- print OUT $$content or die "Can't write to '$arg': $!";
- $content_size += length($$content);
- $ua->progress(($length ? ($content_size / $length) : "tick"), $response);
- if (defined($max_size) && $content_size > $max_size) {
- LWP::Debug::debug("Aborting because size limit exceeded");
- $response->push_header("Client-Aborted", "max_size");
- last;
- }
- }
- close(OUT) or die "Can't write to '$arg': $!";
- }
- elsif (ref($arg) eq 'CODE') {
- # read into callback
- while ($content = &$collector, length $$content) {
- if ($parser) {
- $parser->parse($$content) or undef($parser);
- }
- LWP::Debug::debug("read " . length($$content) . " bytes");
- eval {
- &$arg($$content, $response, $self);
- };
- if ($@) {
- chomp($@);
- $response->push_header('X-Died' => $@);
- $response->push_header("Client-Aborted", "die");
- last;
- }
- $content_size += length($$content);
- $ua->progress(($length ? ($content_size / $length) : "tick"), $response);
- }
- }
- else {
- return HTTP::Response->new(&HTTP::Status::RC_INTERNAL_SERVER_ERROR,
- "Unexpected collect argument '$arg'");
- }
- $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__
-
-=head1 NAME
-
-LWP::Protocol - Base class for LWP protocols
-
-=head1 SYNOPSIS
-
- package LWP::Protocol::foo;
- require LWP::Protocol;
- @ISA=qw(LWP::Protocol);
-
-=head1 DESCRIPTION
-
-This class is used a 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 initialised subclass
-appropriate for that access method. In other words, the
-LWP::Protocol::create() function calls the constructor for one of its
-subclasses.
-
-All derived 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.
-
-The following methods and functions are provided:
-
-=over 4
-
-=item $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.
-
-=item $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.
-
-=item $class = LWP::Protocol::implementor($scheme, [$class])
-
-Get and/or set implementor class for a scheme. Returns '' if the
-specified scheme is not supported.
-
-=item $prot->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.
-
-=item $prot->collect($arg, $response, $collector)
-
-Called to collect the content of a request, and process it
-appropriately into a scalar, file, or by calling a callback. If $arg
-is undefined, then the content is stored within the $response. If
-$arg is a simple scalar, then $arg is interpreted as a file name and
-the content is written to this file. If $arg is a reference to a
-routine, 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 $collector signals EOF by returning a reference to an
-empty sting.
-
-The return value from collect() is the $response object reference.
-
-B<Note:> We will only use the callback or file argument if
-$response->is_success(). This avoids sending content data for
-redirects and authentication responses to the callback which would be
-confusing.
-
-=item $prot->collect_once($arg, $response, $content)
-
-Can be called when the whole response content is available as
-$content. This will invoke collect() with a collector callback that
-returns a reference to $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.
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/LWP/Protocol/GHTTP.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/LWP/Protocol/GHTTP.pm
deleted file mode 100644
index 2a356b5fcb1..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/LWP/Protocol/GHTTP.pm
+++ /dev/null
@@ -1,73 +0,0 @@
-package LWP::Protocol::GHTTP;
-
-# You can tell LWP to use this module for 'http' requests by running
-# code like this before you make requests:
-#
-# require LWP::Protocol::GHTTP;
-# LWP::Protocol::implementor('http', 'LWP::Protocol::GHTTP');
-#
-
-use strict;
-use vars qw(@ISA);
-
-require LWP::Protocol;
-@ISA=qw(LWP::Protocol);
-
-require HTTP::Response;
-require HTTP::Status;
-
-use HTTP::GHTTP qw(METHOD_GET METHOD_HEAD METHOD_POST);
-
-my %METHOD =
-(
- GET => METHOD_GET,
- HEAD => METHOD_HEAD,
- POST => METHOD_POST,
-);
-
-sub request
-{
- my($self, $request, $proxy, $arg, $size, $timeout) = @_;
-
- my $method = $request->method;
- unless (exists $METHOD{$method}) {
- return HTTP::Response->new(&HTTP::Status::RC_BAD_REQUEST,
- "Bad method '$method'");
- }
-
- my $r = HTTP::GHTTP->new($request->uri);
-
- # XXX what headers for repeated headers here?
- $request->headers->scan(sub { $r->set_header(@_)});
-
- $r->set_type($METHOD{$method});
-
- # XXX should also deal with subroutine content.
- my $cref = $request->content_ref;
- $r->set_body($$cref) if length($$cref);
-
- # XXX is this right
- $r->set_proxy($proxy->as_string) if $proxy;
-
- $r->process_request;
-
- my $response = HTTP::Response->new($r->get_status);
-
- # XXX How can get the headers out of $r?? This way is too stupid.
- my @headers;
- eval {
- # Wrapped in eval because this method is not always available
- @headers = $r->get_headers;
- };
- @headers = qw(Date Connection Server Content-type
- Accept-Ranges Server
- Content-Length Last-Modified ETag) if $@;
- for (@headers) {
- my $v = $r->get_header($_);
- $response->header($_ => $v) if defined $v;
- }
-
- return $self->collect_once($arg, $response, $r->get_body);
-}
-
-1;
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/LWP/Protocol/cpan.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/LWP/Protocol/cpan.pm
deleted file mode 100644
index 66d8f213b98..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/LWP/Protocol/cpan.pm
+++ /dev/null
@@ -1,72 +0,0 @@
-package LWP::Protocol::cpan;
-
-use strict;
-use vars qw(@ISA);
-
-require LWP::Protocol;
-@ISA = qw(LWP::Protocol);
-
-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/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/LWP/Protocol/data.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/LWP/Protocol/data.pm
deleted file mode 100644
index 4265326f458..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/LWP/Protocol/data.pm
+++ /dev/null
@@ -1,52 +0,0 @@
-package LWP::Protocol::data;
-
-# Implements access to data:-URLs as specified in RFC 2397
-
-use strict;
-use vars qw(@ISA);
-
-require HTTP::Response;
-require HTTP::Status;
-
-require LWP::Protocol;
-@ISA = 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 new HTTP::Response &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 new HTTP::Response &HTTP::Status::RC_BAD_REQUEST,
- 'Library does not allow method ' .
- "$method for 'data:' URLs";
- }
-
- my $url = $request->url;
- my $response = new HTTP::Response &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"
- );
- $response->content($data) if $method ne "HEAD";
-
- return $response;
-}
-
-1;
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/LWP/Protocol/file.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/LWP/Protocol/file.pm
deleted file mode 100644
index 125335676b4..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/LWP/Protocol/file.pm
+++ /dev/null
@@ -1,148 +0,0 @@
-package LWP::Protocol::file;
-
-require LWP::Protocol;
-@ISA = qw(LWP::Protocol);
-
-use strict;
-
-require LWP::MediaTypes;
-require HTTP::Request;
-require HTTP::Response;
-require HTTP::Status;
-require HTTP::Date;
-
-
-sub request
-{
- my($self, $request, $proxy, $arg, $size) = @_;
-
- LWP::Debug::trace('()');
-
- $size = 4096 unless defined $size and $size > 0;
-
- # check proxy
- if (defined $proxy)
- {
- return new HTTP::Response &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 new HTTP::Response &HTTP::Status::RC_BAD_REQUEST,
- 'Library does not allow method ' .
- "$method for 'file:' URLs";
- }
-
- # check url
- my $url = $request->url;
-
- my $scheme = $url->scheme;
- if ($scheme ne 'file') {
- return new HTTP::Response &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 new HTTP::Response &HTTP::Status::RC_NOT_FOUND,
- "File `$path' does not exist";
- }
- unless (-r _) {
- return new HTTP::Response &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 new HTTP::Response &HTTP::Status::RC_NOT_MODIFIED,
- "$method $path";
- }
- }
-
- # Ok, should be an OK response by now...
- my $response = new HTTP::Response &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 new HTTP::Response &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(F, $path) or return new
- HTTP::Response(&HTTP::Status::RC_INTERNAL_SERVER_ERROR,
- "Cannot read file '$path': $!");
- binmode(F);
- $response = $self->collect($arg, $response, sub {
- my $content = "";
- my $bytes = sysread(F, $content, $size);
- return \$content if $bytes > 0;
- return \ "";
- });
- close(F);
- }
-
- $response;
-}
-
-1;
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/LWP/Protocol/ftp.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/LWP/Protocol/ftp.pm
deleted file mode 100644
index e1d11cd03f5..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/LWP/Protocol/ftp.pm
+++ /dev/null
@@ -1,562 +0,0 @@
-package LWP::Protocol::ftp;
-
-# Implementation of the ftp protocol (RFC 959). We let the Net::FTP
-# package do all the dirty work.
-
-use Carp ();
-
-use HTTP::Status ();
-use HTTP::Negotiate ();
-use HTTP::Response ();
-use LWP::MediaTypes ();
-use File::Listing ();
-
-require LWP::Protocol;
-@ISA = qw(LWP::Protocol);
-
-use strict;
-eval {
- package LWP::Protocol::MyFTP;
-
- require Net::FTP;
- Net::FTP->require_version(2.00);
-
- use vars qw(@ISA);
- @ISA=qw(Net::FTP);
-
- sub new {
- my $class = shift;
- LWP::Debug::trace('()');
-
- my $self = $class->SUPER::new(@_) || return undef;
-
- my $mess = $self->message; # welcome message
- LWP::Debug::debug($mess);
- $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 {
- LWP::Debug::trace('');
- my $self = shift;
- $self->cwd(${*$self}{myftp_home});
- }
-
- sub request_count {
- my $self = shift;
- ++${*$self}{myftp_reqcount};
- }
-
- sub ping {
- LWP::Debug::trace('');
- my $self = shift;
- return $self->go_home;
- }
-
-};
-my $init_failed = $@;
-
-
-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) {
- LWP::Debug::debug('Reusing old connection');
- # 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,
- );
- # 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, $@);
- }
-
- LWP::Debug::debug("Logging in as $user (password $password)...");
- unless ($ftp->login($user, $password, $account)) {
- # Unauthorized. Let's fake a RC_UNAUTHORIZED response
- my $mess = scalar($ftp->message);
- LWP::Debug::debug($mess);
- $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;
- }
- LWP::Debug::debug($ftp->message);
-
- my $home = $ftp->pwd;
- LWP::Debug::debug("home: '$home'");
- $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;
-
- LWP::Debug::trace('()');
-
- # check proxy
- if (defined $proxy)
- {
- return HTTP::Response->new(&HTTP::Status::RC_BAD_REQUEST,
- 'You can not proxy through the ftp');
- }
-
- my $url = $request->url;
- 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");
- }
-
- if ($init_failed) {
- return HTTP::Response->new(&HTTP::Status::RC_INTERNAL_SERVER_ERROR,
- $init_failed);
- }
-
- my $host = $url->host;
- my $port = $url->port;
- my $user = $url->user;
- my $password = $url->password;
-
- # If a basic autorization 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) {
- LWP::Debug::debug("CWD $_");
- unless ($ftp->cwd($_)) {
- return HTTP::Response->new(&HTTP::Status::RC_NOT_FOUND,
- "Can't chdir to $_");
- }
- }
-
- if ($method eq 'GET' || $method eq 'HEAD') {
- LWP::Debug::debug("MDTM");
- 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
- LWP::Debug::debug("retrieve file?");
- 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;
- LWP::Debug::debug($mess);
- 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)) {
- LWP::Debug::debug("chdir before listing failed");
- 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
- LWP::Debug::debug("dir");
- 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->url->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)) {
- LWP::Debug::debug($ftp->message);
- LWP::Debug::debug("$data");
- 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;
- LWP::Debug::debug($ftp->message);
-
- $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/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/LWP/Protocol/gopher.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/LWP/Protocol/gopher.pm
deleted file mode 100644
index 2c93d8b57ea..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/LWP/Protocol/gopher.pm
+++ /dev/null
@@ -1,214 +0,0 @@
-package LWP::Protocol::gopher;
-
-# Implementation of the gopher protocol (RFC 1436)
-#
-# This code is based on 'wwwgopher.pl,v 0.10 1994/10/17 18:12:34 shelden'
-# which in turn is a vastly modified version of Oscar's http'get()
-# dated 28/3/94 in <ftp://cui.unige.ch/PUBLIC/oscar/scripts/http.pl>
-# including contributions from Marc van Heyningen and Martijn Koster.
-
-use strict;
-use vars qw(@ISA);
-
-require HTTP::Response;
-require HTTP::Status;
-require IO::Socket;
-require IO::Select;
-
-require LWP::Protocol;
-@ISA = 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) = @_;
-
- LWP::Debug::trace('()');
-
- $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->url;
- 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,
- 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 =~ s/\015//g; # 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/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/LWP/Protocol/http.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/LWP/Protocol/http.pm
deleted file mode 100644
index 1e290fc0222..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/LWP/Protocol/http.pm
+++ /dev/null
@@ -1,471 +0,0 @@
-package LWP::Protocol::http;
-
-use strict;
-
-require LWP::Debug;
-require HTTP::Response;
-require HTTP::Status;
-require Net::HTTP;
-
-use vars qw(@ISA @EXTRA_SOCK_OPTS);
-
-require LWP::Protocol;
-@ISA = qw(LWP::Protocol);
-
-my $CRLF = "\015\012";
-
-sub _new_socket
-{
- my($self, $host, $port, $timeout) = @_;
- my $conn_cache = $self->{ua}{conn_cache};
- if ($conn_cache) {
- if (my $sock = $conn_cache->withdraw("http", "$host:$port")) {
- return $sock if $sock && !$sock->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.
- $sock->close;
- }
- }
-
- local($^W) = 0; # IO::Socket::INET can be noisy
- my $sock = $self->socket_class->new(PeerAddr => $host,
- PeerPort => $port,
- Proto => 'tcp',
- Timeout => $timeout,
- KeepAlive => !!$conn_cache,
- SendTE => 1,
- $self->_extra_sock_opts($host, $port),
- );
-
- unless ($sock) {
- # IO::Socket::INET leaves additional error messages in $@
- $@ =~ s/^.*?: //;
- die "Can't connect to $host:$port ($@)";
- }
-
- # perl 5.005's IO::Socket does not have the blocking method.
- eval { $sock->blocking(0); };
-
- $sock;
-}
-
-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) {
- # Check the proxy URI's userinfo() for proxy credentials
- # export http_proxy="http://proxyuser:proxypass@proxyhost:port"
- 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) = @_;
- LWP::Debug::trace('()');
-
- $size ||= 4096;
-
- # check method
- my $method = $request->method;
- unless ($method =~ /^[A-Za-z0-9_!\#\$%&\'*+\-.^\`|~]+$/) { # HTTP token
- return new HTTP::Response &HTTP::Status::RC_BAD_REQUEST,
- 'Library does not allow method ' .
- "$method for 'http:' URLs";
- }
-
- my $url = $request->url;
- my($host, $port, $fullpath);
-
- # Check if we're proxy'ing
- if (defined $proxy) {
- # $proxy is an URL to an HTTP server which will proxy this request
- $host = $proxy->host;
- $port = $proxy->port;
- $fullpath = $method eq "CONNECT" ?
- ($url->host . ":" . $url->port) :
- $url->as_string;
- }
- else {
- $host = $url->host;
- $port = $url->port;
- $fullpath = $url->path_query;
- $fullpath = "/$fullpath" unless $fullpath =~ m,^/,;
- }
-
- # connect to remote site
- my $socket = $self->_new_socket($host, $port, $timeout);
- $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 =~ s/\n/ /g;
- 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) {
- do {
- # 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 if $!{EINTR};
- if ($!{EAGAIN}) {
- select(undef, undef, undef, 0.1);
- redo;
- }
- die "write failed: $!";
- }
- if ($n) {
- substr($req_buf, 0, $n, "");
- }
- else {
- select(undef, undef, undef, 0.5);
- }
- }
- while (length $req_buf);
- }
-
- my($code, $mess, @junk);
- my $drop_connection;
-
- if ($has_content) {
- my $eof;
- my $wbuf;
- my $woffset = 0;
- if (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 ($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);
- unless (defined $nfound) {
- if ($!{EINTR} || $!{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} || $!{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);
- }
- 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} || $!{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");
- while (@h) {
- my($k, $v) = splice(@h, 0, 2);
- $response->push_header($k, $v);
- }
- $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', $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} || $!{EAGAIN};
- die "read failed: $!";
- }
- redo READ if $n == -1;
- }
- $complete++ if !$n;
- return \$buf;
- } );
- $drop_connection++ unless $complete;
-
- @h = $socket->get_trailers;
- while (@h) {
- my($k, $v) = splice(@h, 0, 2);
- $response->push_header($k, $v);
- }
-
- # keep-alive support
- unless ($drop_connection) {
- if (my $conn_cache = $self->{ua}{conn_cache}) {
- my %connection = map { (lc($_) => 1) }
- split(/\s*,\s*/, ($response->header("Connection") || ""));
- if (($peer_http_version eq "1.1" && !$connection{close}) ||
- $connection{"keep-alive"})
- {
- LWP::Debug::debug("Keep the http connection to $host:$port");
- $conn_cache->deposit("http", "$host:$port", $socket);
- }
- }
- }
-
- $response;
-}
-
-
-#-----------------------------------------------------------
-package LWP::Protocol::http::SocketMethods;
-
-sub sysread {
- my $self = shift;
- if (my $timeout = ${*$self}{io_socket_timeout}) {
- die "read timeout" unless $self->can_read($timeout);
- }
- else {
- # since we have made the socket non-blocking we
- # use select to wait for some data to arrive
- $self->can_read(undef) || die "Assert";
- }
- sysread($self, $_[0], $_[1], $_[2] || 0);
-}
-
-sub can_read {
- my($self, $timeout) = @_;
- my $fbits = '';
- vec($fbits, fileno($self), 1) = 1;
- SELECT:
- {
- my $before;
- $before = time if $timeout;
- my $nfound = select($fbits, undef, undef, $timeout);
- unless (defined $nfound) {
- if ($!{EINTR} || $!{EAGAIN}) {
- # don't really think EAGAIN can happen here
- if ($timeout) {
- $timeout -= time - $before;
- $timeout = 0 if $timeout < 0;
- }
- redo SELECT;
- }
- die "select failed: $!";
- }
- return $nfound > 0;
- }
-}
-
-sub ping {
- my $self = shift;
- !$self->can_read(0);
-}
-
-sub increment_response_count {
- my $self = shift;
- return ++${*$self}{'myhttp_response_count'};
-}
-
-#-----------------------------------------------------------
-package LWP::Protocol::http::Socket;
-use vars qw(@ISA);
-@ISA = qw(LWP::Protocol::http::SocketMethods Net::HTTP);
-
-1;
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/LWP/Protocol/http10.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/LWP/Protocol/http10.pm
deleted file mode 100644
index e338f24047e..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/LWP/Protocol/http10.pm
+++ /dev/null
@@ -1,303 +0,0 @@
-package LWP::Protocol::http10;
-
-use strict;
-
-require LWP::Debug;
-require HTTP::Response;
-require HTTP::Status;
-require IO::Socket;
-require IO::Select;
-
-use vars qw(@ISA @EXTRA_SOCK_OPTS);
-
-require LWP::Protocol;
-@ISA = qw(LWP::Protocol);
-
-my $CRLF = "\015\012"; # how lines should be terminated;
- # "\r\n" is not correct on all systems, for
- # instance MacPerl defines it to "\012\015"
-
-sub _new_socket
-{
- my($self, $host, $port, $timeout) = @_;
-
- local($^W) = 0; # IO::Socket::INET can be noisy
- my $sock = IO::Socket::INET->new(PeerAddr => $host,
- PeerPort => $port,
- Proto => 'tcp',
- Timeout => $timeout,
- $self->_extra_sock_opts($host, $port),
- );
- unless ($sock) {
- # IO::Socket::INET leaves additional error messages in $@
- $@ =~ s/^.*?: //;
- die "Can't connect to $host:$port ($@)";
- }
- $sock;
-}
-
-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) = @_;
-
- $h->remove_header('Connection'); # need support here to be useful
-
- # HTTP/1.1 will require us to send the 'Host' header, so we might
- # as well start now.
- 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) {
- # Check the proxy URI's userinfo() for proxy credentials
- # export http_proxy="http://proxyuser:proxypass@proxyhost:port"
- 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 request
-{
- my($self, $request, $proxy, $arg, $size, $timeout) = @_;
- LWP::Debug::trace('()');
-
- $size ||= 4096;
-
- # check method
- my $method = $request->method;
- unless ($method =~ /^[A-Za-z0-9_!\#\$%&\'*+\-.^\`|~]+$/) { # HTTP token
- return new HTTP::Response &HTTP::Status::RC_BAD_REQUEST,
- 'Library does not allow method ' .
- "$method for 'http:' URLs";
- }
-
- my $url = $request->url;
- my($host, $port, $fullpath);
-
- # Check if we're proxy'ing
- if (defined $proxy) {
- # $proxy is an URL to an HTTP server which will proxy this request
- $host = $proxy->host;
- $port = $proxy->port;
- $fullpath = $method eq "CONNECT" ?
- ($url->host . ":" . $url->port) :
- $url->as_string;
- }
- else {
- $host = $url->host;
- $port = $url->port;
- $fullpath = $url->path_query;
- $fullpath = "/" unless length $fullpath;
- }
-
- # connect to remote site
- my $socket = $self->_new_socket($host, $port, $timeout);
- $self->_check_sock($request, $socket);
-
- my $sel = IO::Select->new($socket) if $timeout;
-
- my $request_line = "$method $fullpath HTTP/1.0$CRLF";
-
- my $h = $request->headers->clone;
- my $cont_ref = $request->content_ref;
- $cont_ref = $$cont_ref if ref($$cont_ref);
- my $ctype = ref($cont_ref);
-
- # If we're sending content we *have* to specify a content length
- # otherwise the server won't know a messagebody is coming.
- if ($ctype eq 'CODE') {
- die 'No Content-Length header for request with dynamic content'
- unless defined($h->header('Content-Length')) ||
- $h->content_type =~ /^multipart\//;
- # For HTTP/1.1 we could have used chunked transfer encoding...
- }
- else {
- $h->header('Content-Length' => length $$cont_ref)
- if defined($$cont_ref) && length($$cont_ref);
- }
-
- $self->_fixup_header($h, $url, $proxy);
-
- my $buf = $request_line . $h->as_string($CRLF) . $CRLF;
- my $n; # used for return value from syswrite/sysread
- my $length;
- my $offset;
-
- # syswrite $buf
- $length = length($buf);
- $offset = 0;
- while ( $offset < $length ) {
- die "write timeout" if $timeout && !$sel->can_write($timeout);
- $n = $socket->syswrite($buf, $length-$offset, $offset );
- die $! unless defined($n);
- $offset += $n;
- }
- LWP::Debug::conns($buf);
-
- if ($ctype eq 'CODE') {
- while ( ($buf = &$cont_ref()), defined($buf) && length($buf)) {
- # syswrite $buf
- $length = length($buf);
- $offset = 0;
- while ( $offset < $length ) {
- die "write timeout" if $timeout && !$sel->can_write($timeout);
- $n = $socket->syswrite($buf, $length-$offset, $offset );
- die $! unless defined($n);
- $offset += $n;
- }
- LWP::Debug::conns($buf);
- }
- }
- elsif (defined($$cont_ref) && length($$cont_ref)) {
- # syswrite $$cont_ref
- $length = length($$cont_ref);
- $offset = 0;
- while ( $offset < $length ) {
- die "write timeout" if $timeout && !$sel->can_write($timeout);
- $n = $socket->syswrite($$cont_ref, $length-$offset, $offset );
- die $! unless defined($n);
- $offset += $n;
- }
- LWP::Debug::conns($$cont_ref);
- }
-
- # read response line from server
- LWP::Debug::debug('reading response');
-
- my $response;
- $buf = '';
-
- # Inside this loop we will read the response line and all headers
- # found in the response.
- while (1) {
- die "read timeout" if $timeout && !$sel->can_read($timeout);
- $n = $socket->sysread($buf, $size, length($buf));
- die $! unless defined($n);
- die "unexpected EOF before status line seen" unless $n;
- LWP::Debug::conns($buf);
-
- if ($buf =~ s/^(HTTP\/\d+\.\d+)[ \t]+(\d+)[ \t]*([^\012]*)\012//) {
- # HTTP/1.0 response or better
- my($ver,$code,$msg) = ($1, $2, $3);
- $msg =~ s/\015$//;
- LWP::Debug::debug("$ver $code $msg");
- $response = HTTP::Response->new($code, $msg);
- $response->protocol($ver);
-
- # ensure that we have read all headers. The headers will be
- # terminated by two blank lines
- until ($buf =~ /^\015?\012/ || $buf =~ /\015?\012\015?\012/) {
- # must read more if we can...
- LWP::Debug::debug("need more header data");
- die "read timeout" if $timeout && !$sel->can_read($timeout);
- my $old_len = length($buf);
- $n = $socket->sysread($buf, $size, $old_len);
- die $! unless defined($n);
- die "unexpected EOF before all headers seen" unless $n;
- LWP::Debug::conns(substr($buf, $old_len));
- }
-
- # now we start parsing the headers. The strategy is to
- # remove one line at a time from the beginning of the header
- # buffer ($res).
- my($key, $val);
- while ($buf =~ s/([^\012]*)\012//) {
- my $line = $1;
-
- # if we need to restore as content when illegal headers
- # are found.
- my $save = "$line\012";
-
- $line =~ s/\015$//;
- last unless length $line;
-
- if ($line =~ /^([a-zA-Z0-9_\-.]+)\s*:\s*(.*)/) {
- $response->push_header($key, $val) if $key;
- ($key, $val) = ($1, $2);
- }
- elsif ($line =~ /^\s+(.*)/ && $key) {
- $val .= " $1";
- }
- else {
- $response->push_header("Client-Bad-Header-Line" => $line);
- }
- }
- $response->push_header($key, $val) if $key;
- last;
-
- }
- elsif ((length($buf) >= 5 and $buf !~ /^HTTP\//) or
- $buf =~ /\012/ ) {
- # HTTP/0.9 or worse
- LWP::Debug::debug("HTTP/0.9 assume OK");
- $response = HTTP::Response->new(&HTTP::Status::RC_OK, "OK");
- $response->protocol('HTTP/0.9');
- last;
-
- }
- else {
- # need more data
- LWP::Debug::debug("need more status line data");
- }
- };
- $response->request($request);
- $self->_get_sock_info($response, $socket);
-
- if ($method eq "CONNECT") {
- $response->{client_socket} = $socket; # so it can be picked up
- $response->content($buf); # in case we read more than the headers
- return $response;
- }
-
- my $usebuf = length($buf) > 0;
- $response = $self->collect($arg, $response, sub {
- if ($usebuf) {
- $usebuf = 0;
- return \$buf;
- }
- die "read timeout" if $timeout && !$sel->can_read($timeout);
- my $n = $socket->sysread($buf, $size);
- die $! unless defined($n);
- #LWP::Debug::conns($buf);
- return \$buf;
- } );
-
- #$socket->close;
-
- $response;
-}
-
-1;
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/LWP/Protocol/https.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/LWP/Protocol/https.pm
deleted file mode 100644
index 9ec97958b50..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/LWP/Protocol/https.pm
+++ /dev/null
@@ -1,46 +0,0 @@
-package LWP::Protocol::https;
-
-use strict;
-
-use vars qw(@ISA);
-require LWP::Protocol::http;
-@ISA = qw(LWP::Protocol::http);
-
-sub _check_sock
-{
- my($self, $req, $sock) = @_;
- my $check = $req->header("If-SSL-Cert-Subject");
- if (defined $check) {
- my $cert = $sock->get_peer_certificate ||
- die "Missing SSL certificate";
- my $subject = $cert->subject_name;
- die "Bad SSL certificate subject: '$subject' !~ /$check/"
- unless $subject =~ /$check/;
- $req->remove_header("If-SSL-Cert-Subject"); # don't pass it on
- }
-}
-
-sub _get_sock_info
-{
- my $self = shift;
- $self->SUPER::_get_sock_info(@_);
- my($res, $sock) = @_;
- $res->header("Client-SSL-Cipher" => $sock->get_cipher);
- my $cert = $sock->get_peer_certificate;
- if ($cert) {
- $res->header("Client-SSL-Cert-Subject" => $cert->subject_name);
- $res->header("Client-SSL-Cert-Issuer" => $cert->issuer_name);
- }
- if(! eval { $sock->get_peer_verify }) {
- $res->header("Client-SSL-Warning" => "Peer certificate not verified");
- }
-}
-
-#-----------------------------------------------------------
-package LWP::Protocol::https::Socket;
-
-use vars qw(@ISA);
-require Net::HTTPS;
-@ISA = qw(Net::HTTPS LWP::Protocol::http::SocketMethods);
-
-1;
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/LWP/Protocol/https10.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/LWP/Protocol/https10.pm
deleted file mode 100644
index 662ba76d284..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/LWP/Protocol/https10.pm
+++ /dev/null
@@ -1,75 +0,0 @@
-package LWP::Protocol::https10;
-
-use strict;
-
-# Figure out which SSL implementation to use
-use vars qw($SSL_CLASS);
-if ($Net::SSL::VERSION) {
- $SSL_CLASS = "Net::SSL";
-}
-elsif ($IO::Socket::SSL::VERSION) {
- $SSL_CLASS = "IO::Socket::SSL"; # it was already loaded
-}
-else {
- eval { require Net::SSL; }; # from Crypt-SSLeay
- if ($@) {
- require IO::Socket::SSL;
- $SSL_CLASS = "IO::Socket::SSL";
- }
- else {
- $SSL_CLASS = "Net::SSL";
- }
-}
-
-
-use vars qw(@ISA);
-
-require LWP::Protocol::http10;
-@ISA=qw(LWP::Protocol::http10);
-
-sub _new_socket
-{
- my($self, $host, $port, $timeout) = @_;
- local($^W) = 0; # IO::Socket::INET can be noisy
- my $sock = $SSL_CLASS->new(PeerAddr => $host,
- PeerPort => $port,
- Proto => 'tcp',
- Timeout => $timeout,
- );
- unless ($sock) {
- # IO::Socket::INET leaves additional error messages in $@
- $@ =~ s/^.*?: //;
- die "Can't connect to $host:$port ($@)";
- }
- $sock;
-}
-
-sub _check_sock
-{
- my($self, $req, $sock) = @_;
- my $check = $req->header("If-SSL-Cert-Subject");
- if (defined $check) {
- my $cert = $sock->get_peer_certificate ||
- die "Missing SSL certificate";
- my $subject = $cert->subject_name;
- die "Bad SSL certificate subject: '$subject' !~ /$check/"
- unless $subject =~ /$check/;
- $req->remove_header("If-SSL-Cert-Subject"); # don't pass it on
- }
-}
-
-sub _get_sock_info
-{
- my $self = shift;
- $self->SUPER::_get_sock_info(@_);
- my($res, $sock) = @_;
- $res->header("Client-SSL-Cipher" => $sock->get_cipher);
- my $cert = $sock->get_peer_certificate;
- if ($cert) {
- $res->header("Client-SSL-Cert-Subject" => $cert->subject_name);
- $res->header("Client-SSL-Cert-Issuer" => $cert->issuer_name);
- }
- $res->header("Client-SSL-Warning" => "Peer certificate not verified");
-}
-
-1;
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/LWP/Protocol/loopback.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/LWP/Protocol/loopback.pm
deleted file mode 100644
index 2cd67ae3608..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/LWP/Protocol/loopback.pm
+++ /dev/null
@@ -1,26 +0,0 @@
-package LWP::Protocol::loopback;
-
-use strict;
-use vars qw(@ISA);
-require HTTP::Response;
-
-require LWP::Protocol;
-@ISA = 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/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/LWP/Protocol/mailto.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/LWP/Protocol/mailto.pm
deleted file mode 100644
index 73a8885fe40..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/LWP/Protocol/mailto.pm
+++ /dev/null
@@ -1,183 +0,0 @@
-package LWP::Protocol::mailto;
-
-# This module implements the mailto protocol. It is just a simple
-# frontend to the Unix sendmail program except on MacOS, where it uses
-# Mail::Internet.
-
-require LWP::Protocol;
-require HTTP::Request;
-require HTTP::Response;
-require HTTP::Status;
-
-use Carp;
-use strict;
-use vars qw(@ISA $SENDMAIL);
-
-@ISA = qw(LWP::Protocol);
-
-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 new HTTP::Response &HTTP::Status::RC_BAD_REQUEST,
- 'You can not proxy with mail';
- }
-
- # check method
- my $method = $request->method;
-
- if ($method ne 'POST') {
- return new HTTP::Response &HTTP::Status::RC_BAD_REQUEST,
- 'Library does not allow method ' .
- "$method for 'mailto:' URLs";
- }
-
- # check url
- my $url = $request->url;
-
- my $scheme = $url->scheme;
- if ($scheme ne 'mailto') {
- return new HTTP::Response &HTTP::Status::RC_INTERNAL_SERVER_ERROR,
- "LWP::Protocol::mailto::request called for '$scheme'";
- }
- if ($^O eq "MacOS") {
- eval {
- require Mail::Internet;
- };
- if($@) {
- return new HTTP::Response &HTTP::Status::RC_INTERNAL_SERVER_ERROR,
- "You don't have MailTools installed";
- }
- unless ($ENV{SMTPHOSTS}) {
- return new HTTP::Response &HTTP::Status::RC_INTERNAL_SERVER_ERROR,
- "You don't have SMTPHOSTS defined";
- }
- }
- else {
- unless (-x $SENDMAIL) {
- return new HTTP::Response &HTTP::Status::RC_INTERNAL_SERVER_ERROR,
- "You don't have $SENDMAIL";
- }
- }
- if ($^O eq "MacOS") {
- $mail = Mail::Internet->new or
- return new HTTP::Response &HTTP::Status::RC_INTERNAL_SERVER_ERROR,
- "Can't get a Mail::Internet object";
- }
- else {
- open(SENDMAIL, "| $SENDMAIL -oi -t") or
- return new HTTP::Response &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/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/LWP/Protocol/nntp.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/LWP/Protocol/nntp.pm
deleted file mode 100644
index 7bf52869f47..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/LWP/Protocol/nntp.pm
+++ /dev/null
@@ -1,150 +0,0 @@
-package LWP::Protocol::nntp;
-
-# Implementation of the Network News Transfer Protocol (RFC 977)
-
-require LWP::Protocol;
-@ISA = qw(LWP::Protocol);
-
-require LWP::Debug;
-require HTTP::Response;
-require HTTP::Status;
-require Net::NNTP;
-
-use strict;
-
-
-sub request
-{
- my($self, $request, $proxy, $arg, $size, $timeout) = @_;
-
- LWP::Debug::trace('()');
-
- $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->url;
- 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;
- LWP::Debug::debug($mess);
-
- # 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; $nntp = undef;
- $response->code(&HTTP::Status::RC_NOT_FOUND);
- $response->message($nntp->message);
- return $response;
- }
- LWP::Debug::debug($nntp->message);
-
- # 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/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/LWP/Protocol/nogo.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/LWP/Protocol/nogo.pm
deleted file mode 100644
index 53a2ec53433..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/LWP/Protocol/nogo.pm
+++ /dev/null
@@ -1,24 +0,0 @@
-package LWP::Protocol::nogo;
-# If you want to disable access to a particular scheme, use this
-# class and then call
-# LWP::Protocol::implementor(that_scheme, 'LWP::Protocol::nogo');
-# For then on, attempts to access URLs with that scheme will generate
-# a 500 error.
-
-use strict;
-use vars qw(@ISA);
-require HTTP::Response;
-require HTTP::Status;
-require LWP::Protocol;
-@ISA = qw(LWP::Protocol);
-
-sub request {
- my($self, $request) = @_;
- my $scheme = $request->url->scheme;
-
- return HTTP::Response->new(
- &HTTP::Status::RC_INTERNAL_SERVER_ERROR,
- "Access to \'$scheme\' URIs has been disabled"
- );
-}
-1;
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/LWP/RobotUA.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/LWP/RobotUA.pm
deleted file mode 100644
index 5e3ea7237e1..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/LWP/RobotUA.pm
+++ /dev/null
@@ -1,317 +0,0 @@
-package LWP::RobotUA;
-
-require LWP::UserAgent;
-@ISA = qw(LWP::UserAgent);
-$VERSION = "5.813";
-
-require WWW::RobotRules;
-require HTTP::Request;
-require HTTP::Response;
-
-use Carp ();
-use LWP::Debug ();
-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) = @_;
-
- LWP::Debug::trace('()');
-
- # Do we try to access a new server?
- my $allowed = $self->{'rules'}->allowed($request->url);
-
- if ($allowed < 0) {
- LWP::Debug::debug("Host is not visited before, or robots.txt expired.");
- # fetch "robots.txt"
- my $robot_url = $request->url->clone;
- $robot_url->path("robots.txt");
- $robot_url->query(undef);
- LWP::Debug::debug("Requesting $robot_url");
-
- # make access to robot.txt legal since this will be a recursive call
- $self->{'rules'}->parse($robot_url, "");
-
- my $robot_req = new HTTP::Request 'GET', $robot_url;
- my $robot_res = $self->request($robot_req);
- my $fresh_until = $robot_res->fresh_until;
- if ($robot_res->is_success) {
- my $c = $robot_res->content;
- if ($robot_res->content_type =~ m,^text/, && $c =~ /^\s*Disallow\s*:/mi) {
- LWP::Debug::debug("Parsing robot rules");
- $self->{'rules'}->parse($robot_url, $c, $fresh_until);
- }
- else {
- LWP::Debug::debug("Ignoring robots.txt");
- $self->{'rules'}->parse($robot_url, "", $fresh_until);
- }
-
- }
- else {
- LWP::Debug::debug("No robots.txt file found");
- $self->{'rules'}->parse($robot_url, "", $fresh_until);
- }
-
- # recalculate allowed...
- $allowed = $self->{'rules'}->allowed($request->url);
- }
-
- # Check rules
- unless ($allowed) {
- my $res = new HTTP::Response
- &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->url->host_port; };
- my $wait = $self->host_wait($netloc);
-
- if ($wait) {
- LWP::Debug::debug("Must wait $wait seconds");
- if ($self->{'use_sleep'}) {
- sleep($wait)
- }
- else {
- my $res = new HTTP::Response
- &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__
-
-=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
-<URL:http://www.robotstxt.org/>.
-
-When you use a 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 LWP::UserAgent and implements the
-same methods. In addition the following methods are provided:
-
-=over 4
-
-=item $ua = LWP::RobotUA->new( %options )
-
-=item $ua = LWP::RobotUA->new( $agent, $from )
-
-=item $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.
-
-=item $ua->delay
-
-=item $ua->delay( $minutes )
-
-Get/set the minimum delay between requests to the same server, in
-I<minutes>. The default is 1 minute. Note that this number doesn't
-have to be an integer; for example, this sets the delay to 10 seconds:
-
- $ua->delay(10/60);
-
-=item $ua->use_sleep
-
-=item $ua->use_sleep( $boolean )
-
-Get/set a value indicating whether the UA should sleep() if requests
-arrive too fast, defined as $ua->delay minutes not passed since
-last request to the given server. The default is TRUE. If this value is
-FALSE then an internal SERVICE_UNAVAILABLE response will be generated.
-It will have an Retry-After header that indicates when it is OK to
-send another request to this server.
-
-=item $ua->rules
-
-=item $ua->rules( $rules )
-
-Set/get which I<WWW::RobotRules> object to use.
-
-=item $ua->no_visits( $netloc )
-
-Returns the number of documents fetched from this server host. Yeah I
-know, this method should probably have been named num_visits() or
-something like that. :-(
-
-=item $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.
-
-=item $ua->as_string
-
-Returns a string that describes the state of the UA.
-Mainly useful for debugging.
-
-=back
-
-=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.
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/LWP/Simple.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/LWP/Simple.pm
deleted file mode 100644
index 2bdb389fcc5..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/LWP/Simple.pm
+++ /dev/null
@@ -1,352 +0,0 @@
-package LWP::Simple;
-
-use strict;
-use vars qw($ua %loop_check $FULL_LWP @EXPORT @EXPORT_OK $VERSION);
-
-require Exporter;
-
-@EXPORT = qw(get head getprint getstore mirror);
-@EXPORT_OK = qw($ua);
-
-# I really hate this. I 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);
-
-$VERSION = "5.810";
-$FULL_LWP++ if grep {lc($_) eq "http_proxy"} keys %ENV;
-
-
-sub import
-{
- my $pkg = shift;
- my $callpkg = caller;
- if (grep $_ eq '$ua', @_) {
- $FULL_LWP++;
- _init_ua();
- }
- Exporter::export($pkg, $callpkg, @_);
-}
-
-
-sub _init_ua
-{
- require LWP;
- require LWP::UserAgent;
- require HTTP::Status;
- require HTTP::Date;
- $ua = new LWP::UserAgent; # we create a global UserAgent object
- my $ver = $LWP::VERSION = $LWP::VERSION; # avoid warning
- $ua->agent("LWP::Simple/$LWP::VERSION");
- $ua->env_proxy;
-}
-
-
-sub get ($)
-{
- %loop_check = ();
- goto \&_get;
-}
-
-
-sub get_old ($)
-{
- my($url) = @_;
- _init_ua() unless $ua;
-
- my $request = HTTP::Request->new(GET => $url);
- my $response = $ua->request($request);
-
- return $response->content if $response->is_success;
- return undef;
-}
-
-
-sub head ($)
-{
- my($url) = @_;
- _init_ua() unless $ua;
-
- 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) = @_;
- _init_ua() unless $ua;
-
- 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) = @_;
- _init_ua() unless $ua;
-
- my $request = HTTP::Request->new(GET => $url);
- my $response = $ua->request($request, $file);
-
- $response->code;
-}
-
-
-sub mirror ($$)
-{
- my($url, $file) = @_;
- _init_ua() unless $ua;
- my $response = $ua->mirror($url, $file);
- $response->code;
-}
-
-
-sub _get
-{
- my $url = shift;
- my $ret;
- if (!$FULL_LWP && $url =~ m,^http://([^/:\@]+)(?::(\d+))?(/\S*)?$,) {
- my $host = $1;
- my $port = $2 || 80;
- my $path = $3;
- $path = "/" unless defined($path);
- return _trivial_http_get($host, $port, $path);
- }
- else {
- _init_ua() unless $ua;
- if (@_ && $url !~ /^\w+:/) {
- # non-absolute redirect from &_trivial_http_get
- my($host, $port, $path) = @_;
- require URI;
- $url = URI->new_abs($url, "http://$host:$port$path");
- }
- my $request = HTTP::Request->new(GET => $url);
- my $response = $ua->request($request);
- return $response->is_success ? $response->content : undef;
- }
-}
-
-
-sub _trivial_http_get
-{
- my($host, $port, $path) = @_;
- #print "HOST=$host, PORT=$port, PATH=$path\n";
-
- require IO::Socket;
- local($^W) = 0;
- my $sock = IO::Socket::INET->new(PeerAddr => $host,
- PeerPort => $port,
- Proto => 'tcp',
- Timeout => 60) || return undef;
- $sock->autoflush;
- my $netloc = $host;
- $netloc .= ":$port" if $port != 80;
- print $sock join("\015\012" =>
- "GET $path HTTP/1.0",
- "Host: $netloc",
- "User-Agent: lwp-trivial/$VERSION",
- "", "");
-
- my $buf = "";
- my $n;
- 1 while $n = sysread($sock, $buf, 8*1024, length($buf));
- return undef unless defined($n);
-
- if ($buf =~ m,^HTTP/\d+\.\d+\s+(\d+)[^\012]*\012,) {
- my $code = $1;
- #print "CODE=$code\n$buf\n";
- if ($code =~ /^30[1237]/ && $buf =~ /\012Location:\s*(\S+)/i) {
- # redirect
- my $url = $1;
- return undef if $loop_check{$url}++;
- return _get($url, $host, $port, $path);
- }
- return undef unless $code =~ /^2/;
- $buf =~ s/.+?\015?\012\015?\012//s; # zap header
- }
-
- return $buf;
-}
-
-
-1;
-
-__END__
-
-=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 C<LWP::UserAgent> module.
-
-The following functions are provided (and exported) by this module:
-
-=over 3
-
-=item 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 $url argument can
-be either a simple string or a reference to a URI object.
-
-You will not be able to examine the response code or response headers
-(like '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>).
-
-=item 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.
-
-=item 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.
-
-=item getstore($url, $file)
-
-Gets a document identified by a URL and stores it in the file. The
-return value is the HTTP response code.
-
-=item 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.
-
-=back
-
-This module also exports the HTTP::Status constants and procedures.
-You can use them when you check the response code from getprint(),
-getstore() or 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
-
-The HTTP::Status classification functions are:
-
-=over 3
-
-=item is_success($rc)
-
-True if response code indicated a successful request.
-
-=item is_error($rc)
-
-True if response code indicated that an error occurred.
-
-=back
-
-The module will also export the LWP::UserAgent object as C<$ua> if you
-ask for it explicitly.
-
-The user agent created by this module will identify itself as
-"LWP::Simple/#.##" (where "#.##" is the libwww-perl version number)
-and will initialize its proxy defaults from the environment (by
-calling $ua->env_proxy).
-
-=head1 CAVEAT
-
-Note that if you are using both LWP::Simple and the very popular CGI.pm
-module, you may be importing a C<head> function from each module,
-producing a warning like "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>
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/LWP/UserAgent.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/LWP/UserAgent.pm
deleted file mode 100644
index 2c4af305c03..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/LWP/UserAgent.pm
+++ /dev/null
@@ -1,1424 +0,0 @@
-package LWP::UserAgent;
-
-use strict;
-use vars qw(@ISA $VERSION);
-
-require LWP::MemberMixin;
-@ISA = qw(LWP::MemberMixin);
-$VERSION = "5.813";
-
-use HTTP::Request ();
-use HTTP::Response ();
-use HTTP::Date ();
-
-use LWP ();
-use LWP::Debug ();
-use LWP::Protocol ();
-
-use Carp ();
-
-if ($ENV{PERL_LWP_USE_HTTP_10}) {
- require LWP::Protocol::http10;
- LWP::Protocol::implementor('http', 'LWP::Protocol::http10');
- eval {
- require LWP::Protocol::https10;
- LWP::Protocol::implementor('https', 'LWP::Protocol::https10');
- };
-}
-
-
-
-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) = @_;
- LWP::Debug::trace('()');
-
- my $agent = delete $cnf{agent};
- $agent = $class->_agent unless defined $agent;
-
- my $from = delete $cnf{from};
- my $timeout = delete $cnf{timeout};
- $timeout = 3*60 unless defined $timeout;
- 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 $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 = delete $cnf{env_proxy};
-
- 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 {
- from => $from,
- def_headers => undef,
- timeout => $timeout,
- use_eval => $use_eval,
- parse_head => $parse_head,
- show_progress=> $show_progress,
- max_size => $max_size,
- max_redirect => $max_redirect,
- proxy => {},
- no_proxy => [],
- protocols_allowed => $protocols_allowed,
- protocols_forbidden => $protocols_forbidden,
- requests_redirectable => $requests_redirectable,
- }, $class;
-
- $self->agent($agent) if $agent;
- $self->cookie_jar($cookie_jar) if $cookie_jar;
- $self->env_proxy if $env_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;
-}
-
-
-# private method. check sanity of given $request
-sub _request_sanity_check {
- my($self, $request) = @_;
- # some sanity checking
- 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");
- }
-}
-
-
-sub send_request
-{
- my($self, $request, $arg, $size) = @_;
- $self->_request_sanity_check($request);
-
- my($method, $url) = ($request->method, $request->uri);
-
- local($SIG{__DIE__}); # protect against user defined die handlers
-
- # Check that we have a METHOD and a URL first
- return _new_response($request, &HTTP::Status::RC_BAD_REQUEST, "Method missing")
- unless $method;
- return _new_response($request, &HTTP::Status::RC_BAD_REQUEST, "URL missing")
- unless $url;
- return _new_response($request, &HTTP::Status::RC_BAD_REQUEST, "URL must be absolute")
- unless $url->scheme;
-
- LWP::Debug::trace("$method $url");
-
- # Locate protocol to use
- my $scheme = '';
- my $proxy = $self->_need_proxy($url);
- if (defined $proxy) {
- $scheme = $proxy->scheme;
- }
- else {
- $scheme = $url->scheme;
- }
-
- 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) {
- LWP::Debug::trace("$scheme URLs are among $self\'s allowed protocols (@$x)");
- }
- else {
- LWP::Debug::trace("$scheme URLs aren't among $self\'s allowed protocols (@$x)");
- require LWP::Protocol::nogo;
- $protocol = LWP::Protocol::nogo->new;
- }
- }
- elsif ($x = $self->protocols_forbidden) {
- if(grep lc($_) eq $scheme, @$x) {
- LWP::Debug::trace("$scheme URLs are among $self\'s forbidden protocols (@$x)");
- require LWP::Protocol::nogo;
- $protocol = LWP::Protocol::nogo->new;
- }
- else {
- LWP::Debug::trace("$scheme URLs aren't among $self\'s forbidden protocols (@$x)");
- }
- }
- # else fall thru and create the protocol object normally
- }
-
- unless($protocol) {
- $protocol = eval { LWP::Protocol::create($scheme, $self) };
- if ($@) {
- $@ =~ s/ at .* line \d+.*//s; # remove file/line number
- my $response = _new_response($request, &HTTP::Status::RC_NOT_IMPLEMENTED, $@);
- if ($scheme eq "https") {
- $response->message($response->message . " (Crypt::SSLeay not installed)");
- $response->content_type("text/plain");
- $response->content(<<EOT);
-LWP will support https URLs if the Crypt::SSLeay module is installed.
-More information at <http://www.linpro.no/lwp/libwww-perl/README.SSL>.
-EOT
- }
- return $response;
- }
- }
-
- # Extract fields that will be used below
- my ($timeout, $cookie_jar, $use_eval, $parse_head, $max_size) =
- @{$self}{qw(timeout cookie_jar use_eval parse_head max_size)};
-
- my $response;
- $self->progress("begin", $request);
- if ($use_eval) {
- # we eval, and turn dies into responses below
- eval {
- $response = $protocol->request($request, $proxy,
- $arg, $size, $timeout);
- };
- if ($@) {
- $@ =~ s/ at .* line \d+.*//s; # remove file/line number
- $response = _new_response($request,
- &HTTP::Status::RC_INTERNAL_SERVER_ERROR,
- $@);
- }
- }
- else {
- $response = $protocol->request($request, $proxy,
- $arg, $size, $timeout);
- # XXX: Should we die unless $response->is_success ???
- }
-
- $response->request($request); # record request for reference
- $cookie_jar->extract_cookies($response) if $cookie_jar;
- $response->header("Client-Date" => HTTP::Date::time2str(time));
-
- $self->progress("end", $response);
- return $response;
-}
-
-
-sub prepare_request
-{
- my($self, $request) = @_;
- $self->_request_sanity_check($request);
-
- # Extract fields that will be used below
- my ($agent, $from, $cookie_jar, $max_size, $def_headers) =
- @{$self}{qw(agent from cookie_jar max_size def_headers)};
-
- # Set User-Agent and From headers if they are defined
- $request->init_header('User-Agent' => $agent) if $agent;
- $request->init_header('From' => $from) if $from;
- if (defined $max_size) {
- my $last = $max_size - 1;
- $last = 0 if $last < 0; # there is no way to actually request no content
- $request->init_header('Range' => "bytes=0-$last");
- }
- $cookie_jar->add_cookie_header($request) if $cookie_jar;
-
- if ($def_headers) {
- for my $h ($def_headers->header_field_names) {
- $request->init_header($h => [$def_headers->header($h)]);
- }
- }
-
- return($request);
-}
-
-
-sub simple_request
-{
- my($self, $request, $arg, $size) = @_;
- $self->_request_sanity_check($request);
- my $new_request = $self->prepare_request($request);
- return($self->send_request($new_request, $arg, $size));
-}
-
-
-sub request
-{
- my($self, $request, $arg, $size, $previous) = @_;
-
- LWP::Debug::trace('()');
-
- my $response = $self->simple_request($request, $arg, $size);
-
- my $code = $response->code;
- $response->previous($previous) if defined $previous;
-
- LWP::Debug::debug('Simple response: ' .
- (HTTP::Status::status_message($code) ||
- "Unknown code $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->url->scheme eq 'https' &&
- $referral->url->scheme eq 'http')
- {
- # RFC 2616, section 15.1.3.
- LWP::Debug::trace("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->url($referral_uri);
-
- # Check for loop in the redirects, we only count
- my $count = 0;
- my $r = $response;
- while ($r) {
- if (++$count > $self->{max_redirect}) {
- $response->header("Client-Warning" =>
- "Redirect loop detected (max_redirect = $self->{max_redirect})");
- return $response;
- }
- $r = $r->previous;
- }
-
- 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 ? "Proxy-Authenticate" : "WWW-Authenticate";
- my @challenge = $response->header($ch_header);
- unless (@challenge) {
- $response->header("Client-Warning" =>
- "Missing Authenticate header");
- return $response;
- }
-
- require HTTP::Headers::Util;
- CHALLENGE: for my $challenge (@challenge) {
- $challenge =~ tr/,/;/; # "," is used to separate auth-params!!
- ($challenge) = HTTP::Headers::Util::split_header_words($challenge);
- my $scheme = lc(shift(@$challenge));
- shift(@$challenge); # no value
- $challenge = { @$challenge }; # make rest into a hash
- for (keys %$challenge) { # make sure all keys are lower case
- $challenge->{lc $_} = delete $challenge->{$_};
- }
-
- 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 =~ s/-/_/g;
-
- no strict 'refs';
- unless (%{"$class\::"}) {
- # try to load it
- eval "require $class";
- if ($@) {
- if ($@ =~ /^Can\'t locate/) {
- $response->header("Client-Warning" =>
- "Unsupported authentication scheme '$scheme'");
- }
- else {
- $response->header("Client-Warning" => $@);
- }
- 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 post {
- require HTTP::Request::Common;
- my($self, @parameters) = @_;
- my @suff = $self->_process_colonic_headers(\@parameters, (ref($parameters[1]) ? 2 : 1));
- return $self->request( HTTP::Request::Common::POST( @parameters ), @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 _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;
-}
-
-my @ANI = qw(- \ | /);
-
-sub progress {
- my($self, $status, $m) = @_;
- return unless $self->{show_progress};
- 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->url->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, $netloc, $realm, $uid, $pass) = @_;
- @{ $self->{'basic_authentication'}{lc($netloc)}{$realm} } =
- ($uid, $pass);
-}
-
-
-sub get_basic_credentials
-{
- my($self, $realm, $uri, $proxy) = @_;
- return if $proxy;
-
- my $host_port = lc($uri->host_port);
- if (exists $self->{'basic_authentication'}{$host_port}{$realm}) {
- return @{ $self->{'basic_authentication'}{$host_port}{$realm} };
- }
-
- return (undef, undef);
-}
-
-
-sub agent {
- my $self = shift;
- my $old = $self->{agent};
- if (@_) {
- my $agent = shift;
- $agent .= $self->_agent if $agent && $agent =~ /\s+$/;
- $self->{agent} = $agent;
- }
- $old;
-}
-
-
-sub _agent { "libwww-perl/$LWP::VERSION" }
-
-sub timeout { shift->_elem('timeout', @_); }
-sub from { shift->_elem('from', @_); }
-sub parse_head { shift->_elem('parse_head', @_); }
-sub max_size { shift->_elem('max_size', @_); }
-sub max_redirect { shift->_elem('max_redirect', @_); }
-
-
-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;
- }
- $old;
-}
-
-sub default_headers {
- my $self = shift;
- my $old = $self->{def_headers} ||= HTTP::Headers->new;
- if (@_) {
- $self->{def_headers} = shift;
- }
- return $old;
-}
-
-sub default_header {
- my $self = shift;
- return $self->default_headers->header(@_);
-}
-
-
-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;
-}
-
-
-# depreciated
-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
-
- # elements that are references must be handled in a special way
- $copy->{'proxy'} = { %{$self->{'proxy'}} };
- $copy->{'no_proxy'} = [ @{$self->{'no_proxy'}} ]; # copy array
-
- # remove reference to objects for now
- delete $copy->{cookie_jar};
- delete $copy->{conn_cache};
-
- $copy;
-}
-
-
-sub mirror
-{
- my($self, $url, $file) = @_;
-
- LWP::Debug::trace('()');
- my $request = HTTP::Request->new('GET', $url);
-
- 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->is_success) {
-
- my $file_length = (stat($tmpfile))[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";
- }
- else {
- # OK
- 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";
-
- if (my $lm = $response->last_modified) {
- # make sure the file has the same last modification time
- utime $lm, $lm, $file;
- }
- }
- }
- else {
- unlink($tmpfile);
- }
- return $response;
-}
-
-
-sub proxy
-{
- my $self = shift;
- my $key = shift;
-
- LWP::Debug::trace("$key @_");
-
- return map $self->proxy($_, @_), @$key if ref $key;
-
- my $old = $self->{'proxy'}{$key};
- $self->{'proxy'}{$key} = shift if @_;
- return $old;
-}
-
-
-sub env_proxy {
- my ($self) = @_;
- 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 {
- $self->proxy($k, $v);
- }
- }
-}
-
-
-sub no_proxy {
- my($self, @no) = @_;
- if (@no) {
- push(@{ $self->{'no_proxy'} }, @no);
- }
- else {
- $self->{'no_proxy'} = [];
- }
-}
-
-
-# Private method which returns the URL of the Proxy configured for this
-# URL, or undefined if none is configured.
-sub _need_proxy
-{
- my($self, $url) = @_;
- $url = $HTTP::URI_CLASS->new($url) unless ref $url;
-
- my $scheme = $url->scheme || return;
- if (my $proxy = $self->{'proxy'}{$scheme}) {
- if (@{ $self->{'no_proxy'} }) {
- if (my $host = eval { $url->host }) {
- for my $domain (@{ $self->{'no_proxy'} }) {
- if ($host =~ /\Q$domain\E$/) {
- LWP::Debug::trace("no_proxy configured");
- return;
- }
- }
- }
- }
- LWP::Debug::debug("Proxied to $proxy");
- return $HTTP::URI_CLASS->new($proxy);
- }
- LWP::Debug::debug('Not proxied');
- undef;
-}
-
-
-sub _new_response {
- my($request, $code, $message) = @_;
- 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("$code $message\n");
- return $response;
-}
-
-
-1;
-
-__END__
-
-=head1 NAME
-
-LWP::UserAgent - Web user agent class
-
-=head1 SYNOPSIS
-
- require 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->content; # or whatever
- }
- else {
- die $response->status_line;
- }
-
-=head1 DESCRIPTION
-
-The C<LWP::UserAgent> is a class implementing a web user agent.
-C<LWP::UserAgent> objects can be used to dispatch web requests.
-
-In normal use the application creates an C<LWP::UserAgent> object, and
-then configures it with values for timeouts, proxies, name, etc. It
-then creates an instance of C<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 C<HTTP::Response> object. There are
-convenience methods for sending the most common request types: get(),
-head() and post(). When using these methods then 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
-C<HTTP::Request> objects and receive C<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, gopher menus and
-file directories are converted to HTML documents.
-
-=head1 CONSTRUCTOR METHODS
-
-The following constructor methods are available:
-
-=over 4
-
-=item $ua = LWP::UserAgent->new( %options )
-
-This method constructs a new C<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
- max_size undef
- max_redirect 7
- parse_head 1
- protocols_allowed undef
- protocols_forbidden undef
- requests_redirectable ['GET', 'HEAD']
- timeout 180
-
-The following additional options are also accepted: If the
-C<env_proxy> option is passed in with a TRUE value, then proxy
-settings are read from environment variables (see env_proxy() method
-below). If the C<keep_alive> option is passed in, then a
-C<LWP::ConnCache> is set up (see conn_cache() method below). The
-C<keep_alive> value is passed on as the C<total_capacity> for the
-connection cache.
-
-=item $ua->clone
-
-Returns a copy of the LWP::UserAgent object.
-
-=back
-
-=head1 ATTRIBUTES
-
-The settings of the configuration attributes modify the behaviour of the
-C<LWP::UserAgent> when it dispatches requests. Most of these can also
-be initialized by options passed to the constructor method.
-
-The following attributes 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.
-
-=over
-
-=item $ua->agent
-
-=item $ua->agent( $product_id )
-
-Get/set the product token that is used to identify the user agent on
-the network. The agent value is sent as the "User-Agent" header in
-the requests. The default is the string returned by the _agent()
-method (see below).
-
-If the $product_id ends with space then the _agent() 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 "/" character.
-Examples are:
-
- $ua->agent('Checkbot/0.4 ' . $ua->_agent);
- $ua->agent('Checkbot/0.4 '); # same as above
- $ua->agent('Mozilla/5.0');
- $ua->agent(""); # don't identify
-
-=item $ua->_agent
-
-Returns the default agent identifier. This is a string of the form
-"libwww-perl/#.##", where "#.##" is substituted with the version number
-of this library.
-
-=item $ua->from
-
-=item $ua->from( $email_address )
-
-Get/set the e-mail address for the human user who controls
-the requesting user agent. The address should be machine-usable, as
-defined in RFC 822. The C<from> value is send as the "From" header in
-the requests. Example:
-
- $ua->from('gaas@cpan.org');
-
-The default is to not send a "From" header. See the default_headers()
-method for the more general interface that allow any header to be defaulted.
-
-=item $ua->cookie_jar
-
-=item $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 extract_cookies($request) and
-add_cookie_header($response) methods. These methods will then be
-invoked by the user agent as requests are sent and responses are
-received. Normally this will be a C<HTTP::Cookies> object or some
-subclass.
-
-The default is to have no cookie_jar, i.e. never automatically add
-"Cookie" headers to the requests.
-
-Shortcut: If a reference to a plain hash is passed in as the
-$cookie_jar_object, then it is replaced with an instance of
-C<HTTP::Cookies> that is initialized based on the hash. This form also
-automatically loads the C<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"));
-
-=item $ua->default_headers
-
-=item $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 C<HTTP::Headers>
-object. Example:
-
- $ua->default_headers->push_header('Accept-Language' => "no, en");
-
-=item $ua->default_header( $field )
-
-=item $ua->default_header( $field => $value )
-
-This is just a short-cut for $ua->default_headers->header( $field =>
-$value ). Example:
-
- $ua->default_header('Accept-Language' => "no, en");
-
-=item $ua->conn_cache
-
-=item $ua->conn_cache( $cache_obj )
-
-Get/set the C<LWP::ConnCache> object to use. See L<LWP::ConnCache>
-for details.
-
-=item $ua->credentials( $netloc, $realm, $uname, $pass )
-
-Set the user name and password to be used for a realm. It is often more
-useful to specialize the get_basic_credentials() method instead.
-
-The $netloc a string of the form "<host>:<port>". The username and
-password will only be passed to this server. Example:
-
- $ua->credentials("www.example.com:80", "Some Realm", "foo", "secret");
-
-=item $ua->max_size
-
-=item $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
-"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 "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) >>.
-
-=item $ua->max_redirect
-
-=item $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 7. This means that if you call request()
-method 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.
-
-=item $ua->parse_head
-
-=item $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. Do not turn this off, unless you know what you are doing.
-
-=item $ua->protocols_allowed
-
-=item $ua->protocols_allowed( \@protocols )
-
-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-E<gt>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 "ftp://...") will result in a 500 error.
-
-To delete the list, call: C<$ua-E<gt>protocols_allowed(undef)>
-
-By default, an object has neither a C<protocols_allowed> list, nor a
-C<protocols_forbidden> list.
-
-Note that having a C<protocols_allowed> list causes any
-C<protocols_forbidden> list to be ignored.
-
-=item $ua->protocols_forbidden
-
-=item $ua->protocols_forbidden( \@protocols )
-
-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-E<gt>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.
-
-To delete the list, call: C<$ua-E<gt>protocols_forbidden(undef)>
-
-=item $ua->requests_redirectable
-
-=item $ua->requests_redirectable( \@requests )
-
-This reads or sets the object's list of request names that
-C<$ua-E<gt>redirect_ok(...)> will allow redirection for. By
-default, this is C<['GET', 'HEAD']>, as per RFC 2616. To
-change to include 'POST', consider:
-
- push @{ $ua->requests_redirectable }, 'POST';
-
-=item $ua->timeout
-
-=item $ua->timeout( $secs )
-
-Get/set the timeout value in seconds. The default timeout() value is
-180 seconds, i.e. 3 minutes.
-
-The requests 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 request() method to actually
-return might be longer.
-
-=back
-
-=head2 Proxy attributes
-
-The following methods set up when requests should be passed via a
-proxy server.
-
-=over
-
-=item $ua->proxy(\@schemes, $proxy_url)
-
-=item $ua->proxy($scheme, $proxy_url)
-
-Set/retrieve proxy URL for a scheme:
-
- $ua->proxy(['http', 'ftp'], 'http://proxy.sn.no:8001/');
- $ua->proxy('gopher', 'http://proxy.sn.no:8001/');
-
-The first form specifies that the URL is to be used for proxying of
-access methods listed in the list in the first method argument,
-i.e. 'http' and 'ftp'.
-
-The second form shows a shorthand form for specifying
-proxy URL for a single access scheme.
-
-=item $ua->no_proxy( $domain, ... )
-
-Do not proxy requests to the given domains. Calling no_proxy without
-any domains clears the list of domains. Eg:
-
- $ua->no_proxy('localhost', 'no', ...);
-
-=item $ua->env_proxy
-
-Load proxy settings from *_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,my.domain"
- 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 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.
-
-=back
-
-=head1 REQUEST METHODS
-
-The methods described in this section are used to dispatch requests
-via the user agent. The following request methods are provided:
-
-=over
-
-=item $ua->get( $url )
-
-=item $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.
-
-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.
-
-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.
-
-=item $ua->head( $url )
-
-=item $ua->head( $url , $field_name => $value, ... )
-
-This method will dispatch a C<HEAD> request on the given $url.
-Otherwise it works like the get() method described above.
-
-=item $ua->post( $url, \%form )
-
-=item $ua->post( $url, \@form )
-
-=item $ua->post( $url, \%form, $field_name => $value, ... )
-
-=item $ua->post( $url, $field_name => $value,... Content => \%form )
-
-=item $ua->post( $url, $field_name => $value,... Content => \@form )
-
-=item $ua->post( $url, $field_name => $value,... Content => $content )
-
-This method will dispatch a C<POST> request on the given $url, with
-%form or @form providing the key/value pairs for the fill-in form
-content. Additional headers and content options are the same as for
-the get() method.
-
-This method will use the POST() function from C<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.
-
-=item $ua->mirror( $url, $filename )
-
-This method will get the document identified by $url and store it in
-file called $filename. If the file already exists, then the request
-will contain an "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 the the response object.
-
-=item $ua->request( $request )
-
-=item $ua->request( $request, $content_file )
-
-=item $ua->request( $request, $content_cb )
-
-=item $ua->request( $request, $content_cb, $read_size_hint )
-
-This method will dispatch the given $request object. Normally this
-will be an instance of the C<HTTP::Request> class, but any object with
-a similar interface will do. The return value is a response object.
-See L<HTTP::Request> and L<HTTP::Response> for a description of the
-interface provided by these classes.
-
-The request() method will process redirects and authentication
-responses transparently. This means that it may actually send several
-simple requests via the simple_request() method described below.
-
-The request methods described above; get(), head(), post() and
-mirror(), will all dispatch the request they build via this method.
-They are convenience methods that simply hides the creation of the
-request object for you.
-
-The $content_file, $content_cb and $read_size_hint all correspond to
-options described with the get() method above.
-
-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.
-
-=item $ua->simple_request( $request )
-
-=item $ua->simple_request( $request, $content_file )
-
-=item $ua->simple_request( $request, $content_cb )
-
-=item $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 request() described above.
-
-The difference from request() is that simple_request() will not try to
-handle redirects or authentication responses. The request() method
-will in fact invoke this method for each simple request it sends.
-
-=item $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 'http' or
-'ftp') or it might be an 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.
-
-=back
-
-=head2 Callback methods
-
-The following methods will be invoked as requests are processed. These
-methods are documented here because subclasses of C<LWP::UserAgent>
-might want to override their behaviour.
-
-=over
-
-=item $ua->prepare_request( $request )
-
-This method is invoked by simple_request(). Its task is to modify the
-given $request object by setting up various headers based on the
-attributes of the user agent. The return value should normally be the
-$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; "User-Agent",
-"From", "Range" and "Cookie".
-
-=item $ua->redirect_ok( $prospective_request, $response )
-
-This method is called by request() before it tries to follow a
-redirection to the request in $response. This should return a TRUE
-value if this redirection is permissible. The $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 "file://..."
-URL, and TRUE otherwise.
-
-=item $ua->get_basic_credentials( $realm, $uri, $isproxy )
-
-This is called by request() to retrieve credentials for documents
-protected by Basic or Digest Authentication. The arguments passed in
-is the $realm provided by the server, the $uri requested and a 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 credentials() method.
-
-=item $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 $status
-"begin" at the start of processing the request and with $state "end"
-before the request method returns. In between these $status will be
-the fraction of the response currently received or the string "tick"
-if the fraction can't be calculated.
-
-When $status is "begin" the second argument is the request object,
-otherwise it is the response object.
-
-=back
-
-=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 C<LWP::UserAgent>.
-
-=head1 COPYRIGHT
-
-Copyright 1995-2008 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/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/LWP/media.types b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/LWP/media.types
deleted file mode 100644
index 9c883440bc8..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/LWP/media.types
+++ /dev/null
@@ -1,118 +0,0 @@
-# This file defines the mapping from file name extentions to media types.
-# Media types where the subtype does not have the "x-" prefix should be
-# registered by IANA:
-#
-# ftp://www.isi.edu/in-notes/iana/assignments/media-types/
-#
-# See also: RFC-1590
-
-# Text formats
-text/html html htm
-text/plain txt text pm el c h cc hh cxx hxx f90
-text/richtext rtx
-text/tab-separated-values tsv
-
-text/x-setext etx
-text/x-pod pod # Perl documentation
-
-# Image formats
-image/png png
-image/gif gif # Compuserve
-image/ief ief
-image/jpeg jpeg jpg jpe jfif
-image/tiff tiff tif
-
-image/x-cmu-raster ras
-image/x-portable-anymap pnm
-image/x-portable-bitmap pbm
-image/x-portable-graymap pgm
-image/x-portable-pixmap ppm
-image/x-rgb rgb # SGI IRIS
-image/x-xbitmap xbm # X Windows
-image/x-xpixmap xpm # X Windows
-image/x-xwindowdump xwd # X Windows
-image/x-bmp bmp # MS Windows
-image/x-targa tga
-image/x-fits fts
-
-
-# Audio formats
-audio/basic au snd
-audio/x-aiff aif aiff aifc
-audio/x-wav wav # MS Windows
-audio/x-mpeg-2 mp2 # MPEG layer 2 audio
-
-# Video formats
-video/mpeg mpeg mpg mpe
-video/quicktime qt mov
-video/x-msvideo avi
-video/x-sgi-movie movie
-
-# Message
-message/rfc822 mail
-message/partial
-message/external-body
-message/news art
-
-# Applications
-application/octet-stream bin
-application/postscript ai eps ps
-application/oda oda
-application/atomicmail
-application/andrew-insert
-application/slate
-application/wita
-application/dec-dx
-application/dca-rtf
-application/activemessage
-application/rtf rft # MS Word
-application/applefile
-application/mac-binhex40 hqx
-application/news-message-id
-application/news-transmission
-application/wordperfect5.1
-application/pdf pdf
-application/zip zip
-application/macwriteii
-application/msword
-application/remote-printing
-application/mathematica
-application/cybercash
-application/commonground
-application/iges
-application/riscos
-application/eshop
-
-application/x-mif mif # FrameMaker
-application/x-maker fm
-application/x-csh csh
-application/x-dvi dvi
-application/x-hdf hdf
-application/x-latex latex
-application/x-netcdf nc cdf
-application/x-sh sh
-application/x-tcl tcl
-application/x-perl pl
-application/x-tex tex
-application/x-texinfo texinfo texi
-application/x-troff t tr roff
-application/x-troff-man man 1 2 3 4 5 6 7 8
-application/x-troff-me me
-application/x-troff-ms ms
-application/x-wais-source src
-application/x-bcpio bcpio
-application/x-cpio cpio
-application/x-gtar gtar # GNU tar
-application/x-shar shar
-application/x-sv4cpio sv4cpio
-application/x-sv4crc sv4crc
-application/x-tar tar
-application/x-ustar ustar
-
-# Multipart
-multipart/mixed
-multipart/alternative
-multipart/digest
-multipart/parallel
-multipart/appledouble
-multipart/header-set
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Module/ScanDeps.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Module/ScanDeps.pm
deleted file mode 100644
index 462a0764305..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Module/ScanDeps.pm
+++ /dev/null
@@ -1,1324 +0,0 @@
-package Module::ScanDeps;
-
-use 5.006;
-use strict;
-use vars qw( $VERSION @EXPORT @EXPORT_OK $CurrentPackage @IncludeLibs $ScanFileRE );
-
-$VERSION = '0.82';
-@EXPORT = qw( scan_deps scan_deps_runtime );
-@EXPORT_OK = qw( scan_line scan_chunk add_deps scan_deps_runtime path_to_inc_name );
-
-use Config;
-use Exporter;
-use base 'Exporter';
-use constant dl_ext => ".$Config{dlext}";
-use constant lib_ext => $Config{lib_ext};
-use constant is_insensitive_fs => (
- -s $0
- and (-s lc($0) || -1) == (-s uc($0) || -1)
- and (-s lc($0) || -1) == -s $0
-);
-
-use version;
-use Cwd ();
-use File::Path ();
-use File::Temp ();
-use File::Spec ();
-use File::Basename ();
-use FileHandle;
-use Module::Build::ModuleInfo;
-
-$ScanFileRE = qr/(?:^|\\|\/)(?:[^.]*|.*\.(?i:p[ml]|t|al))$/;
-
-=head1 NAME
-
-Module::ScanDeps - Recursively scan Perl code for dependencies
-
-=head1 VERSION
-
-This document describes version 0.82 of Module::ScanDeps, released
-January 28, 2008.
-
-=head1 SYNOPSIS
-
-Via the command-line program L<scandeps.pl>:
-
- % scandeps.pl *.pm # Print PREREQ_PM section for *.pm
- % scandeps.pl -e "use utf8" # Read script from command line
- % scandeps.pl -B *.pm # Include core modules
- % scandeps.pl -V *.pm # Show autoload/shared/data files
-
-Used in a program;
-
- use Module::ScanDeps;
-
- # standard usage
- my $hash_ref = scan_deps(
- files => [ 'a.pl', 'b.pl' ],
- recurse => 1,
- );
-
- # shorthand; assume recurse == 1
- my $hash_ref = scan_deps( 'a.pl', 'b.pl' );
-
- # App::Packer::Frontend compatible interface
- # see App::Packer::Frontend for the structure returned by get_files
- my $scan = Module::ScanDeps->new;
- $scan->set_file( 'a.pl' );
- $scan->set_options( add_modules => [ 'Test::More' ] );
- $scan->calculate_info;
- my $files = $scan->get_files;
-
-=head1 DESCRIPTION
-
-This module scans potential modules used by perl programs, and returns a
-hash reference; its keys are the module names as appears in C<%INC>
-(e.g. C<Test/More.pm>); the values are hash references with this structure:
-
- {
- file => '/usr/local/lib/perl5/5.8.0/Test/More.pm',
- key => 'Test/More.pm',
- type => 'module', # or 'autoload', 'data', 'shared'
- used_by => [ 'Test/Simple.pm', ... ],
- uses => [ 'Test/Other.pm', ... ],
- }
-
-One function, C<scan_deps>, is exported by default. Other
-functions such as (C<scan_line>, C<scan_chunk>, C<add_deps>, C<path_to_inc_name>)
-are exported upon request.
-
-Users of B<App::Packer> may also use this module as the dependency-checking
-frontend, by tweaking their F<p2e.pl> like below:
-
- use Module::ScanDeps;
- ...
- my $packer = App::Packer->new( frontend => 'Module::ScanDeps' );
- ...
-
-Please see L<App::Packer::Frontend> for detailed explanation on
-the structure returned by C<get_files>.
-
-=head2 B<scan_deps>
-
- $rv_ref = scan_deps(
- files => \@files, recurse => $recurse,
- rv => \%rv, skip => \%skip,
- compile => $compile, execute => $execute,
- );
- $rv_ref = scan_deps(@files); # shorthand, with recurse => 1
-
-This function scans each file in C<@files>, registering their
-dependencies into C<%rv>, and returns a reference to the updated
-C<%rv>. The meaning of keys and values are explained above.
-
-If C<$recurse> is true, C<scan_deps> will call itself recursively,
-to perform a breadth-first search on text files (as defined by the
--T operator) found in C<%rv>.
-
-If the C<\%skip> is specified, files that exists as its keys are
-skipped. This is used internally to avoid infinite recursion.
-
-If C<$compile> or C<$execute> is true, runs C<files> in either
-compile-only or normal mode, then inspects their C<%INC> after
-termination to determine additional runtime dependencies.
-
-If C<$execute> is an array reference, runs the files contained
-in it instead of C<@files>.
-
-Additionally, an option C<warn_missing> is recognized. If set to true,
-C<scan_deps> issues a warning to STDERR for every module file that the
-scanned code depends but that wasn't found. Please note that this may
-also report numerous false positives. That is why by default, the heuristic
-silently drops all dependencies it cannot find.
-
-=head2 B<scan_deps_runtime>
-
-Like B<scan_deps>, but skips the static scanning part.
-
-=head2 B<scan_line>
-
- @modules = scan_line($line);
-
-Splits a line into chunks (currently with the semicolon characters), and
-return the union of C<scan_chunk> calls of them.
-
-If the line is C<__END__> or C<__DATA__>, a single C<__END__> element is
-returned to signify the end of the program.
-
-Similarly, it returns a single C<__POD__> if the line matches C</^=\w/>;
-the caller is responsible for skipping appropriate number of lines
-until C<=cut>, before calling C<scan_line> again.
-
-=head2 B<scan_chunk>
-
- $module = scan_chunk($chunk);
- @modules = scan_chunk($chunk);
-
-Apply various heuristics to C<$chunk> to find and return the module
-name(s) it contains. In scalar context, returns only the first module
-or C<undef>.
-
-=head2 B<add_deps>
-
- $rv_ref = add_deps( rv => \%rv, modules => \@modules );
- $rv_ref = add_deps( @modules ); # shorthand, without rv
-
-Resolves a list of module names to its actual on-disk location, by
-finding in C<@INC> and C<@Module::ScanDeps::IncludeLibs>;
-modules that cannot be found are skipped.
-
-This function populates the C<%rv> hash with module/filename pairs, and
-returns a reference to it.
-
-=head2 B<path_to_inc_name>
-
- $perl_name = path_to_inc_name($path, $warn)
-
-Assumes C<$path> refers to a perl file and does it's best to return the
-name as it would appear in %INC. Returns undef if no match was found
-and a prints a warning to STDERR if C<$warn> is true.
-
-E.g. if C<$path> = perl/site/lib/Module/ScanDeps.pm then C<$perl_name>
-will be Module/ScanDeps.pm.
-
-=head1 NOTES
-
-=head2 B<@Module::ScanDeps::IncludeLibs>
-
-You can set this global variable to specify additional directories in
-which to search modules without modifying C<@INC> itself.
-
-=head2 B<$Module::ScanDeps::ScanFileRE>
-
-You can set this global variable to specify a regular expression to
-identify what files to scan. By default it includes all files of
-the following types: .pm, .pl, .t and .al. Additionally, all files
-without a suffix are considered.
-
-For instance, if you want to scan all files then use the following:
-
-C<$Module::ScanDeps::ScanFileRE = qr/./>
-
-=head1 CAVEATS
-
-This module intentially ignores the B<BSDPAN> hack on FreeBSD -- the
-additional directory is removed from C<@INC> altogether.
-
-The static-scanning heuristic is not likely to be 100% accurate, especially
-on modules that dynamically load other modules.
-
-Chunks that span multiple lines are not handled correctly. For example,
-this one works:
-
- use base 'Foo::Bar';
-
-But this one does not:
-
- use base
- 'Foo::Bar';
-
-=cut
-
-my $SeenTk;
-
-# Pre-loaded module dependencies {{{
-my %Preload;
-%Preload = (
- 'AnyDBM_File.pm' => [qw( SDBM_File.pm )],
- 'Authen/SASL.pm' => 'sub',
- 'Bio/AlignIO.pm' => 'sub',
- 'Bio/Assembly/IO.pm' => 'sub',
- 'Bio/Biblio/IO.pm' => 'sub',
- 'Bio/ClusterIO.pm' => 'sub',
- 'Bio/CodonUsage/IO.pm' => 'sub',
- 'Bio/DB/Biblio.pm' => 'sub',
- 'Bio/DB/Flat.pm' => 'sub',
- 'Bio/DB/GFF.pm' => 'sub',
- 'Bio/DB/Taxonomy.pm' => 'sub',
- 'Bio/Graphics/Glyph.pm' => 'sub',
- 'Bio/MapIO.pm' => 'sub',
- 'Bio/Matrix/IO.pm' => 'sub',
- 'Bio/Matrix/PSM/IO.pm' => 'sub',
- 'Bio/OntologyIO.pm' => 'sub',
- 'Bio/PopGen/IO.pm' => 'sub',
- 'Bio/Restriction/IO.pm' => 'sub',
- 'Bio/Root/IO.pm' => 'sub',
- 'Bio/SearchIO.pm' => 'sub',
- 'Bio/SeqIO.pm' => 'sub',
- 'Bio/Structure/IO.pm' => 'sub',
- 'Bio/TreeIO.pm' => 'sub',
- 'Bio/LiveSeq/IO.pm' => 'sub',
- 'Bio/Variation/IO.pm' => 'sub',
- 'Catalyst.pm' => sub {
- return ('Catalyst/Runtime.pm',
- 'Catalyst/Dispatcher.pm',
- _glob_in_inc('Catalyst/DispatchType', 1));
- },
- 'Catalyst/Engine.pm' => 'sub',
- 'Class/MakeMethods.pm' => 'sub',
- 'Config/Any.pm' =>'sub',
- 'Crypt/Random.pm' => sub {
- _glob_in_inc('Crypt/Random/Provider', 1);
- },
- 'Crypt/Random/Generator.pm' => sub {
- _glob_in_inc('Crypt/Random/Provider', 1);
- },
- 'DBI.pm' => sub {
- grep !/\bProxy\b/, _glob_in_inc('DBD', 1);
- },
- 'DBIx/Class.pm' => 'sub',
- 'DBIx/SearchBuilder.pm' => 'sub',
- 'DBIx/ReportBuilder.pm' => 'sub',
- 'Device/ParallelPort.pm' => 'sub',
- 'Device/SerialPort.pm' => [ qw(
- termios.ph asm/termios.ph sys/termiox.ph sys/termios.ph sys/ttycom.ph
- ) ],
- 'Email/Send.pm' => 'sub',
- 'ExtUtils/MakeMaker.pm' => sub {
- grep /\bMM_/, _glob_in_inc('ExtUtils', 1);
- },
- 'File/Basename.pm' => [qw( re.pm )],
- 'File/Spec.pm' => sub {
- require File::Spec;
- map { my $name = $_; $name =~ s!::!/!g; "$name.pm" } @File::Spec::ISA;
- },
- 'HTTP/Message.pm' => [ qw(
- URI/URL.pm URI.pm
- ) ],
- 'Image/Info.pm' => sub {
- return( _glob_in_inc("Image/Info", 1), qw(
- Image/TIFF.pm
- ));
- },
- 'IO.pm' => [ qw(
- IO/Handle.pm IO/Seekable.pm IO/File.pm
- IO/Pipe.pm IO/Socket.pm IO/Dir.pm
- ) ],
- 'IO/Socket.pm' => [qw( IO/Socket/UNIX.pm )],
- 'Log/Log4perl.pm' => 'sub',
- 'LWP/UserAgent.pm' => sub {
- return(
- qw(
- URI/URL.pm URI/http.pm LWP/Protocol/http.pm
- ),
- _glob_in_inc("LWP/Authen", 1),
- _glob_in_inc("LWP/Protocol", 1),
- );
- },
- 'LWP/Parallel.pm' => sub {
- _glob_in_inc( 'LWP/Parallel', 1 ),
- qw(
- LWP/ParallelUA.pm LWP/UserAgent.pm
- LWP/RobotPUA.pm LWP/RobotUA.pm
- ),
- },
- 'LWP/Parallel/UserAgent.pm' => sub {
- qw( LWP/Parallel.pm ),
- @{ _get_preload('LWP/Parallel.pm') }
- },
- 'Locale/Maketext/Lexicon.pm' => 'sub',
- 'Locale/Maketext/GutsLoader.pm' => [qw( Locale/Maketext/Guts.pm )],
- 'Mail/Audit.pm' => 'sub',
- 'Math/BigInt.pm' => 'sub',
- 'Math/BigFloat.pm' => 'sub',
- 'Math/Symbolic.pm' => 'sub',
- 'Module/Build.pm' => 'sub',
- 'Module/Pluggable.pm' => sub {
- _glob_in_inc('$CurrentPackage/Plugin', 1);
- },
- 'MIME/Decoder.pm' => 'sub',
- 'Net/DNS/RR.pm' => 'sub',
- 'Net/FTP.pm' => 'sub',
- 'Net/SSH/Perl.pm' => 'sub',
- 'PDF/API2/Resource/Font.pm' => 'sub',
- 'PDF/API2/Basic/TTF/Font.pm' => sub {
- _glob_in_inc('PDF/API2/Basic/TTF', 1);
- },
- 'PDF/Writer.pm' => 'sub',
- 'POE.pm' => [ qw(
- POE/Kernel.pm POE/Session.pm
- ) ],
- 'POE/Kernel.pm' => sub {
- _glob_in_inc('POE/XS/Resource', 1),
- _glob_in_inc('POE/Resource', 1),
- _glob_in_inc('POE/XS/Loop', 1),
- _glob_in_inc('POE/Loop', 1),
- },
- 'Parse/AFP.pm' => 'sub',
- 'Parse/Binary.pm' => 'sub',
- 'PerlIO.pm' => [ 'PerlIO/scalar.pm' ],
- 'Regexp/Common.pm' => 'sub',
- 'SerialJunk.pm' => [ qw(
- termios.ph asm/termios.ph sys/termiox.ph sys/termios.ph sys/ttycom.ph
- ) ],
- 'SOAP/Lite.pm' => sub {
- (($] >= 5.008 ? ('utf8.pm') : ()), _glob_in_inc('SOAP/Transport', 1));
- },
- 'SQL/Parser.pm' => sub {
- _glob_in_inc('SQL/Dialects', 1);
- },
- 'SQL/Translator/Schema.pm' => sub {
- _glob_in_inc('SQL/Translator', 1);
- },
- 'SVK/Command.pm' => sub {
- _glob_in_inc('SVK', 1);
- },
- 'SVN/Core.pm' => sub {
- _glob_in_inc('SVN', 1),
- map "auto/SVN/$_->{name}", _glob_in_inc('auto/SVN'),
- },
- 'Template.pm' => 'sub',
- 'Term/ReadLine.pm' => 'sub',
- 'Test/Deep.pm' => 'sub',
- 'Tk.pm' => sub {
- $SeenTk = 1;
- qw( Tk/FileSelect.pm Encode/Unicode.pm );
- },
- 'Tk/Balloon.pm' => [qw( Tk/balArrow.xbm )],
- 'Tk/BrowseEntry.pm' => [qw( Tk/cbxarrow.xbm Tk/arrowdownwin.xbm )],
- 'Tk/ColorEditor.pm' => [qw( Tk/ColorEdit.xpm )],
- 'Tk/DragDrop/Common.pm' => sub {
- _glob_in_inc('Tk/DragDrop', 1),
- },
- 'Tk/FBox.pm' => [qw( Tk/folder.xpm Tk/file.xpm )],
- 'Tk/Getopt.pm' => [qw( Tk/openfolder.xpm Tk/win.xbm )],
- 'Tk/Toplevel.pm' => [qw( Tk/Wm.pm )],
- 'URI.pm' => sub {
- grep !/.\b[_A-Z]/, _glob_in_inc('URI', 1);
- },
- 'Win32/EventLog.pm' => [qw( Win32/IPC.pm )],
- 'Win32/Exe.pm' => 'sub',
- 'Win32/TieRegistry.pm' => [qw( Win32API/Registry.pm )],
- 'Win32/SystemInfo.pm' => [qw( Win32/cpuspd.dll )],
- 'XML/Parser.pm' => sub {
- _glob_in_inc('XML/Parser/Style', 1),
- _glob_in_inc('XML/Parser/Encodings', 1),
- },
- 'XML/Parser/Expat.pm' => sub {
- ($] >= 5.008) ? ('utf8.pm') : ();
- },
- 'XML/SAX.pm' => [qw( XML/SAX/ParserDetails.ini ) ],
- 'XMLRPC/Lite.pm' => sub {
- _glob_in_inc('XMLRPC/Transport', 1),;
- },
- 'YAML.pm' => [qw( YAML/Loader.pm YAML/Dumper.pm )],
- 'diagnostics.pm' => sub {
- # shamelessly taken and adapted from diagnostics.pm
- use Config;
- my($privlib, $archlib) = @Config{qw(privlibexp archlibexp)};
- if ($^O eq 'VMS') {
- require VMS::Filespec;
- $privlib = VMS::Filespec::unixify($privlib);
- $archlib = VMS::Filespec::unixify($archlib);
- }
-
- for (
- "pod/perldiag.pod",
- "Pod/perldiag.pod",
- "pod/perldiag-$Config{version}.pod",
- "Pod/perldiag-$Config{version}.pod",
- "pods/perldiag.pod",
- "pods/perldiag-$Config{version}.pod",
- ) {
- return $_ if _find_in_inc($_);
- }
-
- for (
- "$archlib/pods/perldiag.pod",
- "$privlib/pods/perldiag-$Config{version}.pod",
- "$privlib/pods/perldiag.pod",
- ) {
- return $_ if -f $_;
- }
-
- return 'pod/perldiag.pod';
- },
- 'threads/shared.pm' => [qw( attributes.pm )],
- # anybody using threads::shared is likely to declare variables
- # with attribute :shared
- 'utf8.pm' => [
- 'utf8_heavy.pl', do {
- my $dir = 'unicore';
- my @subdirs = qw( To );
- my @files = map "$dir/lib/$_->{name}", _glob_in_inc("$dir/lib");
-
- if (@files) {
- # 5.8.x
- push @files, (map "$dir/$_.pl", qw( Exact Canonical ));
- }
- else {
- # 5.6.x
- $dir = 'unicode';
- @files = map "$dir/Is/$_->{name}", _glob_in_inc("$dir/Is")
- or return;
- push @subdirs, 'In';
- }
-
- foreach my $subdir (@subdirs) {
- foreach (_glob_in_inc("$dir/$subdir")) {
- push @files, "$dir/$subdir/$_->{name}";
- }
- }
- @files;
- }
- ],
- 'charnames.pm' => [
- _find_in_inc('unicore/Name.pl') ? 'unicore/Name.pl' : 'unicode/Name.pl'
- ],
-);
-
-# }}}
-
-sub path_to_inc_name($$) {
- my $path = shift;
- my $warn = shift;
- my $inc_name;
-
- if ($path =~ m/\.pm$/io) {
- die "$path doesn't exist" unless (-f $path);
- my $module_info = Module::Build::ModuleInfo->new_from_file($path);
- die "Module::Build::ModuleInfo error: $!" unless defined($module_info);
- $inc_name = $module_info->name();
- if (defined($inc_name)) {
- $inc_name =~ s|\:\:|\/|og;
- $inc_name .= '.pm';
- } else {
- warn "# Couldn't find include name for $path\n" if $warn;
- }
- } else {
- # Bad solution!
- (my $vol, my $dir, $inc_name) = File::Spec->splitpath($path);
- }
-
- return $inc_name;
-}
-
-my $Keys = 'files|keys|recurse|rv|skip|first|execute|compile|warn_missing';
-sub scan_deps {
- my %args = (
- rv => {},
- (@_ and $_[0] =~ /^(?:$Keys)$/o) ? @_ : (files => [@_], recurse => 1)
- );
-
- if (!defined($args{keys})) {
- $args{keys} = [map {path_to_inc_name($_, $args{warn_missing})} @{$args{files}}];
- }
-
- my ($type, $path);
- foreach my $input_file (@{$args{files}}) {
- if ($input_file !~ $ScanFileRE) {
- warn "Skipping input file $input_file because it matches \$Module::ScanDeps::ScanFileRE\n" if $args{warn_missing};
- next;
- }
-
- $type = 'module';
- $type = 'data' unless $input_file =~ /\.p[mh]$/io;
- $path = $input_file;
- if ($type eq 'module') {
- # necessary because add_deps does the search for shared libraries and such
- add_deps(
- used_by => undef,
- rv => $args{rv},
- modules => [path_to_inc_name($path, $args{warn_missing})],
- skip => undef,
- warn_missing => $args{warn_missing},
- );
- }
- else {
- _add_info(
- rv => $args{rv},
- module => path_to_inc_name($path, $args{warn_missing}),
- file => $path,
- used_by => undef,
- type => $type,
- );
- }
- }
-
- scan_deps_static(\%args);
-
- if ($args{execute} or $args{compile}) {
- scan_deps_runtime(
- rv => $args{rv},
- files => $args{files},
- execute => $args{execute},
- compile => $args{compile},
- skip => $args{skip}
- );
- }
-
- # do not include the input files themselves as dependencies!
- delete $args{rv}{$_} foreach @{$args{files}};
-
- return ($args{rv});
-}
-
-sub scan_deps_static {
- my ($args) = @_;
- my ($files, $keys, $recurse, $rv, $skip, $first, $execute, $compile, $_skip) =
- @$args{qw( files keys recurse rv skip first execute compile _skip )};
-
- $rv ||= {};
- $_skip ||= { %{$skip || {}} };
-
- foreach my $file (@{$files}) {
- my $key = shift @{$keys};
- next if $_skip->{$file}++;
- next if is_insensitive_fs()
- and $file ne lc($file) and $_skip->{lc($file)}++;
- next unless $file =~ $ScanFileRE;
-
- local *FH;
- open FH, $file or die "Cannot open $file: $!";
-
- $SeenTk = 0;
- # Line-by-line scanning
- LINE:
- while (<FH>) {
- chomp(my $line = $_);
- foreach my $pm (scan_line($line)) {
- last LINE if $pm eq '__END__';
-
- # Skip Tk hits from Term::ReadLine and Tcl::Tk
- my $pathsep = qr/\/|\\|::/;
- if ($pm =~ /^Tk\b/) {
- next if $file =~ /(?:^|${pathsep})Term${pathsep}ReadLine\.pm$/;
- next if $file =~ /(?:^|${pathsep})Tcl${pathsep}Tk\W/;
- }
-
- if ($pm eq '__POD__') {
- while (<FH>) { last if (/^=cut/) }
- next LINE;
- }
-
- $pm = 'CGI/Apache.pm' if $file =~ /^Apache(?:\.pm)$/;
-
- add_deps(
- used_by => $key,
- rv => $args->{rv},
- modules => [$pm],
- skip => $args->{skip},
- warn_missing => $args->{warn_missing},
- );
-
- my $preload = _get_preload($pm) or next;
-
- add_deps(
- used_by => $key,
- rv => $args->{rv},
- modules => $preload,
- skip => $args->{skip},
- warn_missing => $args->{warn_missing},
- );
- }
- }
- close FH;
-
- # }}}
- }
-
- # Top-level recursion handling {{{
- while ($recurse) {
- my $count = keys %$rv;
- my @files = sort grep -T $_->{file}, values %$rv;
- scan_deps_static({
- files => [ map $_->{file}, @files ],
- keys => [ map $_->{key}, @files ],
- rv => $rv,
- skip => $skip,
- recurse => 0,
- _skip => $_skip,
- }) or ($args->{_deep} and return);
- last if $count == keys %$rv;
- }
-
- # }}}
-
- return $rv;
-}
-
-sub scan_deps_runtime {
- my %args = (
- perl => $^X,
- rv => {},
- (@_ and $_[0] =~ /^(?:$Keys)$/o) ? @_ : (files => [@_], recurse => 1)
- );
- my ($files, $rv, $execute, $compile, $skip, $perl) =
- @args{qw( files rv execute compile skip perl )};
-
- $files = (ref($files)) ? $files : [$files];
-
- my ($inchash, $incarray, $dl_shared_objects) = ({}, [], []);
- if ($compile) {
- my $file;
-
- foreach $file (@$files) {
- next unless $file =~ $ScanFileRE;
-
- ($inchash, $dl_shared_objects, $incarray) = ({}, [], []);
- _compile($perl, $file, $inchash, $dl_shared_objects, $incarray);
-
- my $rv_sub = _make_rv($inchash, $dl_shared_objects, $incarray);
- _merge_rv($rv_sub, $rv);
- }
- }
- elsif ($execute) {
- my $excarray = (ref($execute)) ? $execute : [@$files];
- my $exc;
- my $first_flag = 1;
- foreach $exc (@$excarray) {
- ($inchash, $dl_shared_objects, $incarray) = ({}, [], []);
- _execute(
- $perl, $exc, $inchash, $dl_shared_objects, $incarray,
- $first_flag
- );
- $first_flag = 0;
- }
-
- # XXX only retains data from last execute ... Why? I suspect
- # the above loop was added later. Needs test cases --Eric
- my $rv_sub = _make_rv($inchash, $dl_shared_objects, $incarray);
- _merge_rv($rv_sub, $rv);
- }
-
- return ($rv);
-}
-
-sub scan_line {
- my $line = shift;
- my %found;
-
- return '__END__' if $line =~ /^__(?:END|DATA)__$/;
- return '__POD__' if $line =~ /^=\w/;
-
- $line =~ s/\s*#.*$//;
- $line =~ s/[\\\/]+/\//g;
-
- foreach (split(/;/, $line)) {
- if (/^\s*package\s+(\w+)/) {
- $CurrentPackage = $1;
- $CurrentPackage =~ s{::}{/}g;
- return;
- }
- # use VERSION:
- if (/^\s*(?:use|require)\s+([\d\._]+)/) {
- # include feaure.pm if we have 5.9.5 or better
- if (version->new($1) >= version->new("5.9.5")) { # seems to catch 5.9, too (but not 5.9.4)
- return "feature.pm";
- }
- }
-
- if (my ($autouse) = /^\s*use\s+autouse\s+(["'].*?["']|\w+)/)
- {
- $autouse =~ s/["']//g;
- $autouse =~ s{::}{/}g;
- return ("autouse.pm", "$autouse.pm");
- }
-
- if (my ($libs) = /\b(?:use\s+lib\s+|(?:unshift|push)\W+\@INC\W+)(.+)/)
- {
- my $archname = defined($Config{archname}) ? $Config{archname} : '';
- my $ver = defined($Config{version}) ? $Config{version} : '';
- foreach (grep(/\w/, split(/["';() ]/, $libs))) {
- unshift(@INC, "$_/$ver") if -d "$_/$ver";
- unshift(@INC, "$_/$archname") if -d "$_/$archname";
- unshift(@INC, "$_/$ver/$archname") if -d "$_/$ver/$archname";
- }
- next;
- }
-
- $found{$_}++ for scan_chunk($_);
- }
-
- return sort keys %found;
-}
-
-sub scan_chunk {
- my $chunk = shift;
-
- # Module name extraction heuristics {{{
- my $module = eval {
- $_ = $chunk;
-
- return [ 'base.pm',
- map { s{::}{/}g; "$_.pm" }
- grep { length and !/^q[qw]?$/ } split(/[^\w:]+/, $1) ]
- if /^\s* use \s+ base \s+ (.*)/sx;
-
- return [ 'prefork.pm',
- map { s{::}{/}g; "$_.pm" }
- grep { length and !/^q[qw]?$/ } split(/[^\w:]+/, $1) ]
-
- if /^\s* use \s+ base \s+ (.*)/sx;
- return [ 'Class/Autouse.pm',
- map { s{::}{/}g; "$_.pm" }
- grep { length and !/^:|^q[qw]?$/ } split(/[^\w:]+/, $1) ]
- if /^\s* use \s+ Class::Autouse \s+ (.*)/sx
- or /^\s* Class::Autouse \s* -> \s* autouse \s* (.*)/sx;
-
- return [ 'POE.pm',
- map { s{::}{/}g; "POE/$_.pm" }
- grep { length and !/^q[qw]?$/ } split(/[^\w:]+/, $1) ]
- if /^\s* use \s+ POE \s+ (.*)/sx;
-
- return [ 'encoding.pm',
- map { _find_encoding($_) }
- grep { length and !/^q[qw]?$/ } split(/[^\w:-]+/, $1) ]
- if /^\s* use \s+ encoding \s+ (.*)/sx;
-
- return $1 if /(?:^|\s)(?:use|no|require)\s+([\w:\.\-\\\/\"\']+)/;
- return $1
- if /(?:^|\s)(?:use|no|require)\s+\(\s*([\w:\.\-\\\/\"\']+)\s*\)/;
-
- if ( s/(?:^|\s)eval\s+\"([^\"]+)\"/$1/
- or s/(?:^|\s)eval\s*\(\s*\"([^\"]+)\"\s*\)/$1/)
- {
- return $1 if /(?:^|\s)(?:use|no|require)\s+([\w:\.\-\\\/\"\']*)/;
- }
-
- if (/(<[^>]*[^\$\w>][^>]*>)/) {
- my $diamond = $1;
- return "File/Glob.pm" if $diamond =~ /[*?\[\]{}~\\]/;
- }
- return "DBD/$1.pm" if /\b[Dd][Bb][Ii]:(\w+):/;
- if (/(?:(:encoding)|\b(?:en|de)code)\(\s*['"]?([-\w]+)/) {
- my $mod = _find_encoding($2);
- return [ 'PerlIO.pm', $mod ] if $1 and $mod;
- return $mod if $mod;
- }
- return $1 if /(?:^|\s)(?:do|require)\s+[^"]*"(.*?)"/;
- return $1 if /(?:^|\s)(?:do|require)\s+[^']*'(.*?)'/;
- return $1 if /[^\$]\b([\w:]+)->\w/ and $1 ne 'Tk' and $1 ne 'shift';
- return $1 if /\b(\w[\w:]*)::\w+\(/ and $1 ne 'main' and $1 ne 'SUPER';
-
- if ($SeenTk) {
- my @modules;
- while (/->\s*([A-Z]\w+)/g) {
- push @modules, "Tk/$1.pm";
- }
- while (/->\s*Scrolled\W+([A-Z]\w+)/g) {
- push @modules, "Tk/$1.pm";
- push @modules, "Tk/Scrollbar.pm";
- }
- return \@modules;
- }
- return;
- };
-
- # }}}
-
- return unless defined($module);
- return wantarray ? @$module : $module->[0] if ref($module);
-
- $module =~ s/^['"]//;
- return unless $module =~ /^\w/;
-
- $module =~ s/\W+$//;
- $module =~ s/::/\//g;
- return if $module =~ /^(?:[\d\._]+|'.*[^']|".*[^"])$/;
-
- $module .= ".pm" unless $module =~ /\./;
- return $module;
-}
-
-sub _find_encoding {
- return unless $] >= 5.008 and eval { require Encode; %Encode::ExtModule };
-
- my $mod = $Encode::ExtModule{ Encode::find_encoding($_[0])->name }
- or return;
- $mod =~ s{::}{/}g;
- return "$mod.pm";
-}
-
-sub _add_info {
- my %args = @_;
- my ($rv, $module, $file, $used_by, $type) = @args{qw/rv module file used_by type/};
-
- return unless defined($module) and defined($file);
-
- # Ensure file is always absolute
- $file = File::Spec->rel2abs($file);
- $file =~ s|\\|\/|go;
-
- # Avoid duplicates that can arise due to case differences that don't actually
- # matter on a case tolerant system
- if (File::Spec->case_tolerant()) {
- foreach my $key (keys %$rv) {
- if (lc($key) eq lc($module)) {
- $module = $key;
- last;
- }
- }
- if (defined($used_by)) {
- if (lc($used_by) eq lc($module)) {
- $used_by = $module;
- } else {
- foreach my $key (keys %$rv) {
- if (lc($key) eq lc($used_by)) {
- $used_by = $key;
- last;
- }
- }
- }
- }
- }
-
- $rv->{$module} ||= {
- file => $file,
- key => $module,
- type => $type,
- };
-
- if (defined($used_by) and $used_by ne $module) {
- push @{ $rv->{$module}{used_by} }, $used_by
- if ( (!File::Spec->case_tolerant() && !grep { $_ eq $used_by } @{ $rv->{$module}{used_by} })
- or ( File::Spec->case_tolerant() && !grep { lc($_) eq lc($used_by) } @{ $rv->{$module}{used_by} }));
-
- # We assume here that another _add_info will be called to provide the other parts of $rv->{$used_by}
- push @{ $rv->{$used_by}{uses} }, $module
- if ( (!File::Spec->case_tolerant() && !grep { $_ eq $module } @{ $rv->{$used_by}{uses} })
- or ( File::Spec->case_tolerant() && !grep { lc($_) eq lc($module) } @{ $rv->{$used_by}{uses} }));
- }
-}
-
-# This subroutine relies on not being called for modules that have already been visited
-sub add_deps {
- my %args =
- ((@_ and $_[0] =~ /^(?:modules|rv|used_by|warn_missing)$/)
- ? @_
- : (rv => (ref($_[0]) ? shift(@_) : undef), modules => [@_]));
-
- my $rv = $args{rv} || {};
- my $skip = $args{skip} || {};
- my $used_by = $args{used_by};
-
- foreach my $module (@{ $args{modules} }) {
- my $file = _find_in_inc($module)
- or _warn_of_missing_module($module, $args{warn_missing}), next;
- next if $skip->{$file};
-
- if (exists $rv->{$module}) {
- _add_info( rv => $rv, module => $module,
- file => $file, used_by => $used_by,
- type => undef );
- next;
- }
-
- my $type = 'module';
- $type = 'data' unless $file =~ /\.p[mh]$/i;
- _add_info( rv => $rv, module => $module,
- file => $file, used_by => $used_by,
- type => $type );
-
- if ($module =~ /(.*?([^\/]*))\.p[mh]$/i) {
- my ($path, $basename) = ($1, $2);
-
- foreach (_glob_in_inc("auto/$path")) {
- next if $_->{file} =~ m{\bauto/$path/.*/}; # weed out subdirs
- next if $_->{name} =~ m/(?:^|\/)\.(?:exists|packlist)$/;
- my $ext = lc($1) if $_->{name} =~ /(\.[^.]+)$/;
- next if $ext eq lc(lib_ext());
- my $type = 'shared' if $ext eq lc(dl_ext());
- $type = 'autoload' if $ext eq '.ix' or $ext eq '.al';
- $type ||= 'data';
-
- _add_info( rv => $rv, module => "auto/$path/$_->{name}",
- file => $_->{file}, used_by => $module,
- type => $type );
- }
- }
- }
-
- return $rv;
-}
-
-sub _find_in_inc {
- my $file = shift;
-
- foreach my $dir (grep !/\bBSDPAN\b/, @INC, @IncludeLibs) {
- return "$dir/$file" if -f "$dir/$file";
- }
-
- # absolute file names
- return $file if -f $file;
-
- return;
-}
-
-sub _glob_in_inc {
- my $subdir = shift;
- my $pm_only = shift;
- my @files;
-
- require File::Find;
-
- $subdir =~ s/\$CurrentPackage/$CurrentPackage/;
-
- foreach my $dir (map "$_/$subdir", grep !/\bBSDPAN\b/, @INC, @IncludeLibs) {
- next unless -d $dir;
- File::Find::find(
- sub {
- my $name = $File::Find::name;
- $name =~ s!^\Q$dir\E/!!;
- return if $pm_only and lc($name) !~ /\.p[mh]$/i;
- push @files, $pm_only
- ? "$subdir/$name"
- : { file => $File::Find::name,
- name => $name,
- }
- if -f;
- },
- $dir
- );
- }
-
- return @files;
-}
-
-# App::Packer compatibility functions
-
-sub new {
- my ($class, $self) = @_;
- return bless($self ||= {}, $class);
-}
-
-sub set_file {
- my $self = shift;
- foreach my $script (@_) {
- my ($vol, $dir, $file) = File::Spec->splitpath($script);
- $self->{main} = {
- key => $file,
- file => $script,
- };
- }
-}
-
-sub set_options {
- my $self = shift;
- my %args = @_;
- foreach my $module (@{ $args{add_modules} }) {
- $module =~ s/::/\//g;
- $module .= '.pm' unless $module =~ /\.p[mh]$/i;
- my $file = _find_in_inc($module)
- or _warn_of_missing_module($module, $args{warn_missing}), next;
- $self->{files}{$module} = $file;
- }
-}
-
-sub calculate_info {
- my $self = shift;
- my $rv = scan_deps(
- 'keys' => [ $self->{main}{key}, sort keys %{ $self->{files} }, ],
- files => [ $self->{main}{file},
- map { $self->{files}{$_} } sort keys %{ $self->{files} },
- ],
- recurse => 1,
- );
-
- my $info = {
- main => { file => $self->{main}{file},
- store_as => $self->{main}{key},
- },
- };
-
- my %cache = ($self->{main}{key} => $info->{main});
- foreach my $key (sort keys %{ $self->{files} }) {
- my $file = $self->{files}{$key};
-
- $cache{$key} = $info->{modules}{$key} = {
- file => $file,
- store_as => $key,
- used_by => [ $self->{main}{key} ],
- };
- }
-
- foreach my $key (sort keys %{$rv}) {
- my $val = $rv->{$key};
- if ($cache{ $val->{key} }) {
- defined($val->{used_by}) or next;
- push @{ $info->{ $val->{type} }->{ $val->{key} }->{used_by} },
- @{ $val->{used_by} };
- }
- else {
- $cache{ $val->{key} } = $info->{ $val->{type} }->{ $val->{key} } =
- { file => $val->{file},
- store_as => $val->{key},
- used_by => $val->{used_by},
- };
- }
- }
-
- $self->{info} = { main => $info->{main} };
-
- foreach my $type (sort keys %{$info}) {
- next if $type eq 'main';
-
- my @val;
- if (UNIVERSAL::isa($info->{$type}, 'HASH')) {
- foreach my $val (sort values %{ $info->{$type} }) {
- @{ $val->{used_by} } = map $cache{$_} || "!!$_!!",
- @{ $val->{used_by} };
- push @val, $val;
- }
- }
-
- $type = 'modules' if $type eq 'module';
- $self->{info}{$type} = \@val;
- }
-}
-
-sub get_files {
- my $self = shift;
- return $self->{info};
-}
-
-# scan_deps_runtime utility functions
-
-sub _compile {
- my ($perl, $file, $inchash, $dl_shared_objects, $incarray) = @_;
-
- my ($fhout, $fname) = File::Temp::tempfile("XXXXXX");
- my $fhin = FileHandle->new($file) or die "Couldn't open $file\n";
-
- my $line = do { local $/; <$fhin> };
- $line =~ s/use Module::ScanDeps::DataFeed.*?\n//sg;
- $line =~ s/^(.*?)((?:[\r\n]+__(?:DATA|END)__[\r\n]+)|$)/
-use Module::ScanDeps::DataFeed '$fname.out';
-sub {
-$1
-}
-$2/s;
- $fhout->print($line);
- $fhout->close;
- $fhin->close;
-
- system($perl, $fname);
-
- _extract_info("$fname.out", $inchash, $dl_shared_objects, $incarray);
- unlink("$fname");
- unlink("$fname.out");
-}
-
-sub _execute {
- my ($perl, $file, $inchash, $dl_shared_objects, $incarray, $firstflag) = @_;
-
- $DB::single = $DB::single = 1;
- my ($fhout, $fname) = File::Temp::tempfile("XXXXXX");
- $fname = _abs_path($fname);
- my $fhin = FileHandle->new($file) or die "Couldn't open $file";
-
- my $line = do { local $/; <$fhin> };
- $line =~ s/use Module::ScanDeps::DataFeed.*?\n//sg;
- $line = "use Module::ScanDeps::DataFeed '$fname.out';\n" . $line;
- $fhout->print($line);
- $fhout->close;
- $fhin->close;
-
- File::Path::rmtree( ['_Inline'], 0, 1); # XXX hack
- system($perl, (map { "-I$_" } @IncludeLibs), $fname) == 0 or die "SYSTEM ERROR in executing $file: $?";
-
- _extract_info("$fname.out", $inchash, $dl_shared_objects, $incarray);
- unlink("$fname");
- unlink("$fname.out");
-}
-
-# create a new hashref, applying fixups
-sub _make_rv {
- my ($inchash, $dl_shared_objects, $inc_array) = @_;
-
- my $rv = {};
- my @newinc = map(quotemeta($_), @$inc_array);
- my $inc = join('|', sort { length($b) <=> length($a) } @newinc);
- # don't pack lib/c:/ or lib/C:/
- $inc = qr/$inc/i if(is_insensitive_fs());
-
- require File::Spec;
-
- my $key;
- foreach $key (keys(%$inchash)) {
- my $newkey = $key;
- $newkey =~ s"^(?:(?:$inc)/?)""sg if File::Spec->file_name_is_absolute($newkey);
-
- $rv->{$newkey} = {
- 'used_by' => [],
- 'file' => $inchash->{$key},
- 'type' => _gettype($inchash->{$key}),
- 'key' => $key
- };
- }
-
- my $dl_file;
- foreach $dl_file (@$dl_shared_objects) {
- my $key = $dl_file;
- $key =~ s"^(?:(?:$inc)/?)""s;
-
- $rv->{$key} = {
- 'used_by' => [],
- 'file' => $dl_file,
- 'type' => 'shared',
- 'key' => $key
- };
- }
-
- return $rv;
-}
-
-sub _extract_info {
- my ($fname, $inchash, $dl_shared_objects, $incarray) = @_;
-
- use vars qw(%inchash @dl_shared_objects @incarray);
- my $fh = FileHandle->new($fname) or die "Couldn't open $fname";
- my $line = do { local $/; <$fh> };
- $fh->close;
-
- eval $line;
-
- $inchash->{$_} = $inchash{$_} for keys %inchash;
- @$dl_shared_objects = @dl_shared_objects;
- @$incarray = @incarray;
-}
-
-sub _gettype {
- my $name = shift;
- my $dlext = quotemeta(dl_ext());
-
- return 'autoload' if $name =~ /(?:\.ix|\.al|\.bs)$/i;
- return 'module' if $name =~ /\.p[mh]$/i;
- return 'shared' if $name =~ /\.$dlext$/i;
- return 'data';
-}
-
-# merge all keys from $rv_sub into the $rv mega-ref
-sub _merge_rv {
- my ($rv_sub, $rv) = @_;
-
- my $key;
- foreach $key (keys(%$rv_sub)) {
- my %mark;
- if ($rv->{$key} and _not_dup($key, $rv, $rv_sub)) {
- warn "Different modules for file '$key' were found.\n"
- . " -> Using '" . _abs_path($rv_sub->{$key}{file}) . "'.\n"
- . " -> Ignoring '" . _abs_path($rv->{$key}{file}) . "'.\n";
- $rv->{$key}{used_by} = [
- grep (!$mark{$_}++,
- @{ $rv->{$key}{used_by} },
- @{ $rv_sub->{$key}{used_by} })
- ];
- @{ $rv->{$key}{used_by} } = grep length, @{ $rv->{$key}{used_by} };
- $rv->{$key}{file} = $rv_sub->{$key}{file};
- }
- elsif ($rv->{$key}) {
- $rv->{$key}{used_by} = [
- grep (!$mark{$_}++,
- @{ $rv->{$key}{used_by} },
- @{ $rv_sub->{$key}{used_by} })
- ];
- @{ $rv->{$key}{used_by} } = grep length, @{ $rv->{$key}{used_by} };
- }
- else {
- $rv->{$key} = {
- used_by => [ @{ $rv_sub->{$key}{used_by} } ],
- file => $rv_sub->{$key}{file},
- key => $rv_sub->{$key}{key},
- type => $rv_sub->{$key}{type}
- };
-
- @{ $rv->{$key}{used_by} } = grep length, @{ $rv->{$key}{used_by} };
- }
- }
-}
-
-sub _not_dup {
- my ($key, $rv1, $rv2) = @_;
- if (File::Spec->case_tolerant()) {
- return lc(_abs_path($rv1->{$key}{file})) ne lc(_abs_path($rv2->{$key}{file}));
- }
- else {
- return _abs_path($rv1->{$key}{file}) ne _abs_path($rv2->{$key}{file});
- }
-}
-
-sub _abs_path {
- return join(
- '/',
- Cwd::abs_path(File::Basename::dirname($_[0])),
- File::Basename::basename($_[0]),
- );
-}
-
-
-sub _warn_of_missing_module {
- my $module = shift;
- my $warn = shift;
- return if not $warn;
- return if not $module =~ /\.p[ml]$/;
- warn "# Could not find source file '$module' in \@INC or \@IncludeLibs. Skipping it.\n"
- if not -f $module;
-}
-
-sub _get_preload {
- my $pm = shift;
- my $preload = $Preload{$pm} or return();
- if ($preload eq 'sub') {
- $pm =~ s/\.p[mh]$//i;
- $preload = [ _glob_in_inc($pm, 1) ];
- }
- elsif (UNIVERSAL::isa($preload, 'CODE')) {
- $preload = [ $preload->($pm) ];
- }
- return $preload;
-}
-
-1;
-__END__
-
-=head1 SEE ALSO
-
-L<scandeps.pl> is a bundled utility that writes C<PREREQ_PM> section
-for a number of files.
-
-An application of B<Module::ScanDeps> is to generate executables from
-scripts that contains prerequisite modules; this module supports two
-such projects, L<PAR> and L<App::Packer>. Please see their respective
-documentations on CPAN for further information.
-
-=head1 AUTHORS
-
-Audrey Tang E<lt>cpan@audreyt.orgE<gt>
-
-To a lesser degree: Steffen Mueller E<lt>smueller@cpan.orgE<gt>
-
-Parts of heuristics were deduced from:
-
-=over 4
-
-=item *
-
-B<PerlApp> by ActiveState Tools Corp L<http://www.activestate.com/>
-
-=item *
-
-B<Perl2Exe> by IndigoStar, Inc L<http://www.indigostar.com/>
-
-=back
-
-The B<scan_deps_runtime> function is contributed by Edward S. Peschko.
-
-L<http://par.perl.org/> is the official website for this module. You
-can write to the mailing list at E<lt>par@perl.orgE<gt>, or send an empty
-mail to E<lt>par-subscribe@perl.orgE<gt> to participate in the discussion.
-
-Please submit bug reports to E<lt>bug-Module-ScanDeps@rt.cpan.orgE<gt>.
-
-=head1 COPYRIGHT
-
-Copyright 2002-2008 by
-Audrey Tang E<lt>cpan@audreyt.orgE<gt>;
-2005-2008 by Steffen Mueller E<lt>smueller@cpan.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/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Module/ScanDeps/DataFeed.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Module/ScanDeps/DataFeed.pm
deleted file mode 100644
index 70c679b0339..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Module/ScanDeps/DataFeed.pm
+++ /dev/null
@@ -1,143 +0,0 @@
-package Module::ScanDeps::DataFeed;
-# No compile time deps!
-#use strict;
-$Module::ScanDeps::DataFeed::VERSION = '0.09';
-
-=head1 NAME
-
-Module::ScanDeps::DataFeed - Runtime dependency scanning helper
-
-=head1 SYNOPSIS
-
-(internal use only)
-
-=head1 DESCRIPTION
-
-No user-serviceable parts inside.
-
-This module is used by the L<Module::ScanDeps> run- and compile-time scanners.
-It is included in the code run by C<Module::ScanDeps> and will write
-a string of loaded modules and C<@INC> entries to a file. This is
-achieved using an C<END {}> hook.
-
-Implementation might change, so don't use it outside of Module::ScanDeps!
-
-=cut
-
-my $_filename;
-
-sub import {
- my ($pkg, $filename) = @_;
- # This is the file we'll write the @INC and %INC info to at END.
- $_filename = $filename;
-
- my $fname = __PACKAGE__;
- $fname =~ s{::}{/}g;
- delete $INC{"$fname.pm"} unless $Module::ScanDeps::DataFeed::Loaded;
- $Module::ScanDeps::DataFeed::Loaded++;
-}
-
-END {
- # Write %INC and @INC to the file specified at compile time in import()
- defined $_filename or return;
-
- my %inc = %INC;
- my @inc = @INC;
- my @dl_so = _dl_shared_objects();
-
- require Cwd;
- require File::Basename;
- require DynaLoader;
-
- open(FH, "> $_filename") or die "Couldn't open $_filename\n";
- print FH '%inchash = (' . "\n\t";
- print FH join(
- ',' => map {
- sprintf(
- "\n\t'$_' => '%s/%s'",
- Cwd::abs_path(File::Basename::dirname($inc{$_})),
- File::Basename::basename($inc{$_}),
- ),
- } keys(%inc)
- );
- print FH "\n);\n";
-
- print FH '@incarray = (' . "\n\t";
- # inner map escapes trailing backslashes
- print FH join(',', map("\n\t'$_'", map {s/\\$/\\\\/; $_} @inc));
- print FH "\n);\n";
-
- my @dl_bs = @dl_so;
- s/(\.so|\.dll)$/\.bs/ for @dl_bs;
-
- print FH '@dl_shared_objects = (' . "\n\t";
- print FH join(
- ',' => map("\n\t'$_'", grep -e, @dl_so, @dl_bs)
- );
- print FH "\n);\n";
- close FH;
-}
-
-sub _dl_shared_objects {
- if (@DynaLoader::dl_shared_objects) {
- return @DynaLoader::dl_shared_objects;
- }
- elsif (@DynaLoader::dl_modules) {
- return map { _dl_mod2filename($_) } @DynaLoader::dl_modules;
- }
-
- return;
-}
-
-sub _dl_mod2filename {
- my $mod = shift;
-
- return if $mod eq 'B';
- return unless defined &{"$mod\::bootstrap"};
-
- eval { require B; require Config; 1 } or return;
- my $dl_ext = $Config::Config{dlext} if %Config::Config;
-
- # Copied from XSLoader
- my @modparts = split(/::/, $mod);
- my $modfname = $modparts[-1];
- my $modpname = join('/', @modparts);
-
- foreach my $dir (@INC) {
- my $file = "$dir/auto/$modpname/$modfname.$dl_ext";
- return $file if -r $file;
- }
-
- return;
-}
-
-1;
-
-=head1 SEE ALSO
-
-L<Module::ScanDeps>
-
-=head1 AUTHORS
-
-Edward S. Peschko E<lt>esp5@pge.comE<gt>,
-Audrey Tang E<lt>cpan@audreyt.orgE<gt>,
-to a lesser degree Steffen Mueller E<lt>smueller@cpan.orgE<gt>
-
-L<http://par.perl.org/> is the official website for this module. You
-can write to the mailing list at E<lt>par@perl.orgE<gt>, or send an empty
-mail to E<lt>par-subscribe@perl.orgE<gt> to participate in the discussion.
-
-Please submit bug reports to E<lt>bug-Module-ScanDeps@rt.cpan.orgE<gt>.
-
-=head1 COPYRIGHT
-
-Copyright 2004-2007 by Edward S. Peschko E<lt>esp5@pge.comE<gt>,
-Audrey Tang E<lt>cpan@audreyt.orgE<gt>,
-Steffen Mueller E<lt>smueller@cpan.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/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Module/Signature.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Module/Signature.pm
deleted file mode 100644
index f239e3ba429..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Module/Signature.pm
+++ /dev/null
@@ -1,884 +0,0 @@
-package Module::Signature;
-$Module::Signature::VERSION = '0.55';
-
-use 5.005;
-use strict;
-use vars qw($VERSION $SIGNATURE @ISA @EXPORT_OK);
-use vars qw($Preamble $Cipher $Debug $Verbose $Timeout);
-use vars qw($KeyServer $KeyServerPort $AutoKeyRetrieve $CanKeyRetrieve);
-
-use constant CANNOT_VERIFY => '0E0';
-use constant SIGNATURE_OK => 0;
-use constant SIGNATURE_MISSING => -1;
-use constant SIGNATURE_MALFORMED => -2;
-use constant SIGNATURE_BAD => -3;
-use constant SIGNATURE_MISMATCH => -4;
-use constant MANIFEST_MISMATCH => -5;
-use constant CIPHER_UNKNOWN => -6;
-
-use ExtUtils::Manifest ();
-use Exporter;
-
-@EXPORT_OK = (
- qw(sign verify),
- qw($SIGNATURE $KeyServer $Cipher $Preamble),
- (grep { /^[A-Z_]+_[A-Z_]+$/ } keys %Module::Signature::),
-);
-@ISA = 'Exporter';
-
-$SIGNATURE = 'SIGNATURE';
-$Timeout = $ENV{MODULE_SIGNATURE_TIMEOUT} || 3;
-$Verbose = $ENV{MODULE_SIGNATURE_VERBOSE} || 0;
-$KeyServer = $ENV{MODULE_SIGNATURE_KEYSERVER} || 'pgp.mit.edu';
-$KeyServerPort = $ENV{MODULE_SIGNATURE_KEYSERVERPORT} || '11371';
-$Cipher = $ENV{MODULE_SIGNATURE_CIPHER} || 'SHA1';
-$Preamble = << ".";
-This file contains message digests of all files listed in MANIFEST,
-signed via the Module::Signature module, version $VERSION.
-
-To verify the content in this distribution, first make sure you have
-Module::Signature installed, then type:
-
- % cpansign -v
-
-It will check each file's integrity, as well as the signature's
-validity. If "==> Signature verified OK! <==" is not displayed,
-the distribution may already have been compromised, and you should
-not run its Makefile.PL or Build.PL.
-
-.
-
-$AutoKeyRetrieve = 1;
-$CanKeyRetrieve = undef;
-
-sub verify {
- my %args = ( skip => 1, @_ );
- my $rv;
-
- (-r $SIGNATURE) or do {
- warn "==> MISSING Signature file! <==\n";
- return SIGNATURE_MISSING;
- };
-
- (my $sigtext = _read_sigfile($SIGNATURE)) or do {
- warn "==> MALFORMED Signature file! <==\n";
- return SIGNATURE_MALFORMED;
- };
-
- (my ($cipher) = ($sigtext =~ /^(\w+) /)) or do {
- warn "==> MALFORMED Signature file! <==\n";
- return SIGNATURE_MALFORMED;
- };
-
- (defined(my $plaintext = _mkdigest($cipher))) or do {
- warn "==> UNKNOWN Cipher format! <==\n";
- return CIPHER_UNKNOWN;
- };
-
- $rv = _verify($SIGNATURE, $sigtext, $plaintext);
-
- if ($rv == SIGNATURE_OK) {
- my ($mani, $file) = _fullcheck($args{skip});
-
- if (@{$mani} or @{$file}) {
- warn "==> MISMATCHED content between MANIFEST and distribution files! <==\n";
- return MANIFEST_MISMATCH;
- }
- else {
- warn "==> Signature verified OK! <==\n" if $Verbose;
- }
- }
- elsif ($rv == SIGNATURE_BAD) {
- warn "==> BAD/TAMPERED signature detected! <==\n";
- }
- elsif ($rv == SIGNATURE_MISMATCH) {
- warn "==> MISMATCHED content between SIGNATURE and distribution files! <==\n";
- }
-
- return $rv;
-}
-
-sub _verify {
- my $signature = shift || $SIGNATURE;
- my $sigtext = shift || '';
- my $plaintext = shift || '';
-
- local $SIGNATURE = $signature if $signature ne $SIGNATURE;
-
- if ($AutoKeyRetrieve and !$CanKeyRetrieve) {
- if (!defined $CanKeyRetrieve) {
- require IO::Socket::INET;
- my $sock = IO::Socket::INET->new(
- Timeout => $Timeout,
- PeerAddr => "$KeyServer:$KeyServerPort",
- );
- $CanKeyRetrieve = ($sock ? 1 : 0);
- $sock->shutdown(2) if $sock;
- }
- $AutoKeyRetrieve = $CanKeyRetrieve;
- }
-
- if (my $version = _has_gpg()) {
- return _verify_gpg($sigtext, $plaintext, $version);
- }
- elsif (eval {require Crypt::OpenPGP; 1}) {
- return _verify_crypt_openpgp($sigtext, $plaintext);
- }
- else {
- warn "Cannot use GnuPG or Crypt::OpenPGP, please install either one first!\n";
- return _compare($sigtext, $plaintext, CANNOT_VERIFY);
- }
-}
-
-sub _has_gpg {
- `gpg --version` =~ /GnuPG.*?(\S+)$/m or return;
- return $1;
-}
-
-sub _fullcheck {
- my $skip = shift;
- my @extra;
-
- local $^W;
- local $ExtUtils::Manifest::Quiet = 1;
-
- my($mani, $file);
- if( _legacy_extutils() ) {
- my $_maniskip = &ExtUtils::Manifest::_maniskip;
-
- local *ExtUtils::Manifest::_maniskip = sub { sub {
- return unless $skip;
- my $ok = $_maniskip->(@_);
- if ($ok ||= (!-e 'MANIFEST.SKIP' and _default_skip(@_))) {
- print "Skipping $_\n" for @_;
- push @extra, @_;
- }
- return $ok;
- } };
-
- ($mani, $file) = ExtUtils::Manifest::fullcheck();
- }
- else {
- ($mani, $file) = ExtUtils::Manifest::fullcheck();
- }
-
- foreach my $makefile ('Makefile', 'Build') {
- warn "==> SKIPPED CHECKING '$_'!" .
- (-e "$_.PL" && " (run $_.PL to ensure its integrity)") .
- " <===\n" for grep $_ eq $makefile, @extra;
- }
-
- @{$mani} = grep {$_ ne 'SIGNATURE'} @{$mani};
-
- warn "Not in MANIFEST: $_\n" for @{$file};
- warn "No such file: $_\n" for @{$mani};
-
- return ($mani, $file);
-}
-
-sub _legacy_extutils {
- # ExtUtils::Manifest older than 1.41 does not handle default skips well.
- return (ExtUtils::Manifest->VERSION < 1.41);
-}
-
-sub _default_skip {
- local $_ = shift;
- return 1 if /\bRCS\b/ or /\bCVS\b/ or /\B\.svn\b/ or /,v$/
- or /^MANIFEST\.bak/ or /^Makefile$/ or /^blib\//
- or /^MakeMaker-\d/ or /^pm_to_blib/ or /^blibdirs/
- or /^_build\// or /^Build$/ or /^pmfiles\.dat/
- or /~$/ or /\.old$/ or /\#$/ or /^\.#/;
-}
-
-sub _verify_gpg {
- my ($sigtext, $plaintext, $version) = @_;
-
- local $SIGNATURE = Win32::GetShortPathName($SIGNATURE)
- if defined &Win32::GetShortPathName and $SIGNATURE =~ /[^-\w.:~\\\/]/;
-
- my $keyserver = _keyserver($version);
-
- my @quiet = $Verbose ? () : qw(-q --logger-fd=1);
- my @cmd = (
- qw(gpg --verify --batch --no-tty), @quiet, ($KeyServer ? (
- "--keyserver=$keyserver",
- ($AutoKeyRetrieve and $version ge '1.0.7')
- ? '--keyserver-options=auto-key-retrieve'
- : ()
- ) : ()), $SIGNATURE
- );
-
- my $output = '';
- if( $Verbose ) {
- warn "Executing @cmd\n";
- system @cmd;
- }
- else {
- my $cmd = join ' ', @cmd;
- $output = `$cmd`;
- }
-
- if( $? ) {
- print STDERR $output;
- }
- elsif ($output =~ /((?: +[\dA-F]{4}){10,})/) {
- warn "WARNING: This key is not certified with a trusted signature!\n";
- warn "Primary key fingerprint:$1\n";
- }
-
- return SIGNATURE_BAD if ($? and $AutoKeyRetrieve);
- return _compare($sigtext, $plaintext, (!$?) ? SIGNATURE_OK : CANNOT_VERIFY);
-}
-
-sub _keyserver {
- my $version = shift;
- my $scheme = 'x-hkp';
- $scheme = 'hkp' if $version ge '1.2.0';
-
- return "$scheme://$KeyServer:$KeyServerPort";
-}
-
-sub _verify_crypt_openpgp {
- my ($sigtext, $plaintext) = @_;
-
- require Crypt::OpenPGP;
- my $pgp = Crypt::OpenPGP->new(
- ($KeyServer) ? ( KeyServer => $KeyServer, AutoKeyRetrieve => $AutoKeyRetrieve ) : (),
- );
- my $rv = $pgp->handle( Filename => $SIGNATURE )
- or die $pgp->errstr;
-
- return SIGNATURE_BAD if (!$rv->{Validity} and $AutoKeyRetrieve);
-
- if ($rv->{Validity}) {
- warn 'Signature made ', scalar localtime($rv->{Signature}->timestamp),
- ' using key ID ', substr(uc(unpack('H*', $rv->{Signature}->key_id)), -8), "\n",
- "Good signature from \"$rv->{Validity}\"\n" if $Verbose;
- }
- else {
- warn "Cannot verify signature; public key not found\n";
- }
-
- return _compare($sigtext, $plaintext, $rv->{Validity} ? SIGNATURE_OK : CANNOT_VERIFY);
-}
-
-sub _read_sigfile {
- my $sigfile = shift;
- my $signature = '';
- my $well_formed;
-
- local *D;
- open D, $sigfile or die "Could not open $sigfile: $!";
-
- if ($] >= 5.006 and <D> =~ /\r/) {
- close D;
- open D, $sigfile or die "Could not open $sigfile: $!";
- binmode D, ':crlf';
- } else {
- close D;
- open D, $sigfile or die "Could not open $sigfile: $!";
- }
-
- while (<D>) {
- next if (1 .. /^-----BEGIN PGP SIGNED MESSAGE-----/);
- last if /^-----BEGIN PGP SIGNATURE/;
-
- $signature .= $_;
- }
-
- return ((split(/\n+/, $signature, 2))[1]);
-}
-
-sub _compare {
- my ($str1, $str2, $ok) = @_;
-
- # normalize all linebreaks
- $str1 =~ s/[^\S ]+/\n/g; $str2 =~ s/[^\S ]+/\n/g;
-
- return $ok if $str1 eq $str2;
-
- if (eval { require Text::Diff; 1 }) {
- warn "--- $SIGNATURE ".localtime((stat($SIGNATURE))[9])."\n";
- warn '+++ (current) '.localtime()."\n";
- warn Text::Diff::diff( \$str1, \$str2, { STYLE => 'Unified' } );
- }
- else {
- local (*D, *S);
- open S, $SIGNATURE or die "Could not open $SIGNATURE: $!";
- open D, "| diff -u $SIGNATURE -" or (warn "Could not call diff: $!", return SIGNATURE_MISMATCH);
- while (<S>) {
- print D $_ if (1 .. /^-----BEGIN PGP SIGNED MESSAGE-----/);
- print D if (/^Hash: / .. /^$/);
- next if (1 .. /^-----BEGIN PGP SIGNATURE/);
- print D $str2, "-----BEGIN PGP SIGNATURE-----\n", $_ and last;
- }
- print D <S>;
- close D;
- }
-
- return SIGNATURE_MISMATCH;
-}
-
-sub sign {
- my %args = ( skip => 1, @_ );
- my $overwrite = $args{overwrite};
- my $plaintext = _mkdigest();
-
- my ($mani, $file) = _fullcheck($args{skip});
-
- if (@{$mani} or @{$file}) {
- warn "==> MISMATCHED content between MANIFEST and the distribution! <==\n";
- warn "==> Please correct your MANIFEST file and/or delete extra files. <==\n";
- }
-
- if (!$overwrite and -e $SIGNATURE and -t STDIN) {
- local $/ = "\n";
- print "$SIGNATURE already exists; overwrite [y/N]? ";
- return unless <STDIN> =~ /[Yy]/;
- }
-
- if (my $version = _has_gpg()) {
- _sign_gpg($SIGNATURE, $plaintext, $version);
- }
- elsif (eval {require Crypt::OpenPGP; 1}) {
- _sign_crypt_openpgp($SIGNATURE, $plaintext);
- }
- else {
- die 'Cannot use GnuPG or Crypt::OpenPGP, please install either one first!';
- }
-
- warn "==> SIGNATURE file created successfully. <==\n";
- return SIGNATURE_OK;
-}
-
-sub _sign_gpg {
- my ($sigfile, $plaintext, $version) = @_;
-
- die "Could not write to $sigfile"
- if -e $sigfile and (-d $sigfile or not -w $sigfile);
-
- local *D;
- open D, "| gpg --clearsign >> $sigfile.tmp" or die "Could not call gpg: $!";
- print D $plaintext;
- close D;
-
- (-e "$sigfile.tmp" and -s "$sigfile.tmp") or do {
- unlink "$sigfile.tmp";
- die "Cannot find $sigfile.tmp, signing aborted.\n";
- };
-
- open D, "$sigfile.tmp" or die "Cannot open $sigfile.tmp: $!";
-
- open S, ">$sigfile" or do {
- unlink "$sigfile.tmp";
- die "Could not write to $sigfile: $!";
- };
-
- print S $Preamble;
- print S <D>;
-
- close S;
- close D;
-
- unlink("$sigfile.tmp");
-
- my $key_id;
- my $key_name;
- # This doesn't work because the output from verify goes to STDERR.
- # If I try to redirect it using "--logger-fd 1" it just hangs.
- # WTF?
- my @verify = `gpg --batch --verify $SIGNATURE`;
- while (@verify) {
- if (/key ID ([0-9A-F]+)$/) {
- $key_id = $1;
- } elsif (/signature from "(.+)"$/) {
- $key_name = $1;
- }
- }
-
- my $found_name;
- my $found_key;
- if (defined $key_id && defined $key_name) {
- my $keyserver = _keyserver($version);
- while (`gpg --batch --keyserver=$keyserver --search-keys '$key_name'`) {
- if (/^\(\d+\)/) {
- $found_name = 0;
- } elsif ($found_name) {
- if (/key \Q$key_id\E/) {
- $found_key = 1;
- last;
- }
- }
-
- if (/\Q$key_name\E/) {
- $found_name = 1;
- next;
- }
- }
-
- unless ($found_key) {
- _warn_non_public_signature($key_name);
- }
- }
-
- return 1;
-}
-
-sub _sign_crypt_openpgp {
- my ($sigfile, $plaintext) = @_;
-
- require Crypt::OpenPGP;
- my $pgp = Crypt::OpenPGP->new;
- my $ring = Crypt::OpenPGP::KeyRing->new(
- Filename => $pgp->{cfg}->get('SecRing')
- ) or die $pgp->error(Crypt::OpenPGP::KeyRing->errstr);
- my $kb = $ring->find_keyblock_by_index(-1)
- or die $pgp->error('Can\'t find last keyblock: ' . $ring->errstr);
-
- my $cert = $kb->signing_key;
- my $uid = $cert->uid($kb->primary_uid);
- warn "Debug: acquiring signature from $uid\n" if $Debug;
-
- my $signature = $pgp->sign(
- Data => $plaintext,
- Detach => 0,
- Clearsign => 1,
- Armour => 1,
- Key => $cert,
- PassphraseCallback => \&Crypt::OpenPGP::_default_passphrase_cb,
- ) or die $pgp->errstr;
-
-
- local *D;
- open D, "> $sigfile" or die "Could not write to $sigfile: $!";
- print D $Preamble;
- print D $signature;
- close D;
-
- require Crypt::OpenPGP::KeyServer;
- my $server = Crypt::OpenPGP::KeyServer->new(Server => $KeyServer);
-
- unless ($server->find_keyblock_by_keyid($cert->key_id)) {
- _warn_non_public_signature($uid);
- }
-
- return 1;
-}
-
-sub _warn_non_public_signature {
- my $uid = shift;
-
- warn <<"EOF"
-You have signed this distribution with a key ($uid) that cannot be
-found on the public key server at $KeyServer.
-
-This will probably cause signature verification to fail if your module
-is distributed on CPAN.
-EOF
-}
-
-sub _mkdigest {
- my $digest = _mkdigest_files(undef, @_) or return;
- my $plaintext = '';
-
- foreach my $file (sort keys %$digest) {
- next if $file eq $SIGNATURE;
- $plaintext .= "@{$digest->{$file}} $file\n";
- }
-
- return $plaintext;
-}
-
-sub _mkdigest_files {
- my $p = shift;
- my $algorithm = shift || $Cipher;
- my $dosnames = (defined(&Dos::UseLFN) && Dos::UseLFN()==0);
- my $read = ExtUtils::Manifest::maniread() || {};
- my $found = ExtUtils::Manifest::manifind($p);
- my(%digest) = ();
- my $obj = eval { Digest->new($algorithm) } || eval {
- my ($base, $variant) = ($algorithm =~ /^(\w+?)(\d+)$/g) or die;
- require "Digest/$base.pm"; "Digest::$base"->new($variant)
- } || eval {
- require "Digest/$algorithm.pm"; "Digest::$algorithm"->new
- } || eval {
- my ($base, $variant) = ($algorithm =~ /^(\w+?)(\d+)$/g) or die;
- require "Digest/$base/PurePerl.pm"; "Digest::$base\::PurePerl"->new($variant)
- } || eval {
- require "Digest/$algorithm/PurePerl.pm"; "Digest::$algorithm\::PurePerl"->new
- } or do { eval {
- my ($base, $variant) = ($algorithm =~ /^(\w+?)(\d+)$/g) or die;
- warn "Unknown cipher: $algorithm, please install Digest::$base, Digest::$base$variant, or Digest::$base\::PurePerl\n";
- } and return } or do {
- warn "Unknown cipher: $algorithm, please install Digest::$algorithm\n"; return;
- };
-
- foreach my $file (sort keys %$read){
- warn "Debug: collecting digest from $file\n" if $Debug;
- if ($dosnames){
- $file = lc $file;
- $file =~ s!(\.(\w|-)+)!substr ($1,0,4)!ge;
- $file =~ s!((\w|-)+)!substr ($1,0,8)!ge;
- }
- unless ( exists $found->{$file} ) {
- warn "No such file: $file\n" if $Verbose;
- }
- else {
- local *F;
- open F, $file or die "Cannot open $file for reading: $!";
- if (-B $file) {
- binmode(F);
- $obj->addfile(*F);
- }
- elsif ($] >= 5.006) {
- binmode(F, ':crlf');
- $obj->addfile(*F);
- }
- elsif ($^O eq 'MSWin32') {
- $obj->addfile(*F);
- }
- else {
- # Normalize by hand...
- local $/;
- binmode(F);
- my $input = <F>;
- $input =~ s/\015?\012/\n/g;
- $obj->add($input);
- }
- $digest{$file} = [$algorithm, $obj->hexdigest];
- $obj->reset;
- }
- }
-
- return \%digest;
-}
-
-1;
-
-__END__
-
-=head1 NAME
-
-Module::Signature - Module signature file manipulation
-
-=head1 VERSION
-
-This document describes version 0.54 of B<Module::Signature>,
-released May 12, 2006.
-
-=head1 SYNOPSIS
-
-As a shell command:
-
- % cpansign # verify an existing SIGNATURE, or
- # make a new one if none exists
-
- % cpansign sign # make signature; overwrites existing one
- % cpansign -s # same thing
-
- % cpansign verify # verify a signature
- % cpansign -v # same thing
- % cpansign -v --skip # ignore files in MANIFEST.SKIP
-
- % cpansign help # display this documentation
- % cpansign -h # same thing
-
-In programs:
-
- use Module::Signature qw(sign verify SIGNATURE_OK);
- sign();
- sign(overwrite => 1); # overwrites without asking
-
- # see the CONSTANTS section below
- (verify() == SIGNATURE_OK) or die "failed!";
-
-=head1 DESCRIPTION
-
-B<Module::Signature> adds cryptographic authentications to CPAN
-distributions, via the special F<SIGNATURE> file.
-
-If you are a module user, all you have to do is to remember to run
-C<cpansign -v> (or just C<cpansign>) before issuing C<perl Makefile.PL>
-or C<perl Build.PL>; that will ensure the distribution has not been
-tampered with.
-
-Module authors can easily add the F<SIGNATURE> file to the distribution
-tarball; see L</NOTES> below for how to do it as part of C<make dist>.
-
-If you I<really> want to sign a distribution manually, simply add
-C<SIGNATURE> to F<MANIFEST>, then type C<cpansign -s> immediately
-before C<make dist>. Be sure to delete the F<SIGNATURE> file afterwards.
-
-Please also see L</NOTES> about F<MANIFEST.SKIP> issues, especially if
-you are using B<Module::Build> or writing your own F<MANIFEST.SKIP>.
-
-=head1 VARIABLES
-
-No package variables are exported by default.
-
-=over 4
-
-=item $Verbose
-
-If true, Module::Signature will give information during processing including
-gpg output. If false, Module::Signature will be as quiet as possible as
-long as everything is working ok. Defaults to false.
-
-=item $SIGNATURE
-
-The filename for a distribution's signature file. Defaults to
-C<SIGNATURE>.
-
-=item $KeyServer
-
-The OpenPGP key server for fetching the author's public key
-(currently only implemented on C<gpg>, not C<Crypt::OpenPGP>).
-May be set to a false value to prevent this module from
-fetching public keys.
-
-=item $KeyServerPort
-
-The OpenPGP key server port, defaults to C<11371>.
-
-=item $Timeout
-
-Maximum time to wait to try to establish a link to the key server.
-Defaults to C<3>.
-
-=item $AutoKeyRetrieve
-
-Whether to automatically fetch unknown keys from the key server.
-Defaults to C<1>.
-
-=item $Cipher
-
-The default cipher used by the C<Digest> module to make signature
-files. Defaults to C<SHA1>, but may be changed to other ciphers
-via the C<MODULE_SIGNATURE_CIPHER> environment variable if the SHA1
-cipher is undesirable for the user.
-
-The cipher specified in the F<SIGNATURE> file's first entry will
-be used to validate its integrity. For C<SHA1>, the user needs
-to have any one of these four modules installed: B<Digest::SHA>,
-B<Digest::SHA1>, B<Digest::SHA::PurePerl>, or (currently nonexistent)
-B<Digest::SHA1::PurePerl>.
-
-=item $Preamble
-
-The explanatory text written to newly generated F<SIGNATURE> files
-before the actual entries.
-
-=back
-
-=head1 ENVIRONMENT
-
-B<Module::Signature> honors these environment variables:
-
-=over 4
-
-=item MODULE_SIGNATURE_CIPHER
-
-Works like C<$Cipher>.
-
-=item MODULE_SIGNATURE_VERBOSE
-
-Works like C<$Verbose>.
-
-=item MODULE_SIGNATURE_KEYSERVER
-
-Works like C<$KeyServer>.
-
-=item MODULE_SIGNATURE_KEYSERVERPORT
-
-Works like C<$KeyServerPort>.
-
-=item MODULE_SIGNATURE_TIMEOUT
-
-Works like C<$Timeout>.
-
-=back
-
-=head1 CONSTANTS
-
-These constants are not exported by default.
-
-=over 4
-
-=item CANNOT_VERIFY (C<0E0>)
-
-Cannot verify the OpenPGP signature, maybe due to the lack of a network
-connection to the key server, or if neither gnupg nor Crypt::OpenPGP
-exists on the system.
-
-=item SIGNATURE_OK (C<0>)
-
-Signature successfully verified.
-
-=item SIGNATURE_MISSING (C<-1>)
-
-The F<SIGNATURE> file does not exist.
-
-=item SIGNATURE_MALFORMED (C<-2>)
-
-The signature file does not contains a valid OpenPGP message.
-
-=item SIGNATURE_BAD (C<-3>)
-
-Invalid signature detected -- it might have been tampered with.
-
-=item SIGNATURE_MISMATCH (C<-4>)
-
-The signature is valid, but files in the distribution have changed
-since its creation.
-
-=item MANIFEST_MISMATCH (C<-5>)
-
-There are extra files in the current directory not specified by
-the MANIFEST file.
-
-=item CIPHER_UNKNOWN (C<-6>)
-
-The cipher used by the signature file is not recognized by the
-C<Digest> and C<Digest::*> modules.
-
-=back
-
-=head1 NOTES
-
-=head2 Signing your module as part of C<make dist>
-
-The easiest way is to use B<Module::Install>:
-
- sign; # put this before "WriteAll"
- WriteAll;
-
-For B<ExtUtils::MakeMaker> (version 6.18 or above), you may do this:
-
- WriteMakefile(
- (MM->can('signature_target') ? (SIGN => 1) : ()),
- # ... original arguments ...
- );
-
-Users of B<Module::Build> may do this:
-
- Module::Build->new(
- (sign => 1),
- # ... original arguments ...
- )->create_build_script;
-
-=head2 F<MANIFEST.SKIP> Considerations
-
-(The following section is lifted from Iain Truskett's B<Test::Signature>
-module, under the Perl license. Thanks, Iain!)
-
-It is B<imperative> that your F<MANIFEST> and F<MANIFEST.SKIP> files be
-accurate and complete. If you are using C<ExtUtils::MakeMaker> and you
-do not have a F<MANIFEST.SKIP> file, then don't worry about the rest of
-this. If you do have a F<MANIFEST.SKIP> file, or you use
-C<Module::Build>, you must read this.
-
-Since the test is run at C<make test> time, the distribution has been
-made. Thus your F<MANIFEST.SKIP> file should have the entries listed
-below.
-
-If you're using C<ExtUtils::MakeMaker>, you should have, at least:
-
- #defaults
- ^Makefile$
- ^blib/
- ^pm_to_blib
- ^blibdirs
-
-These entries are part of the default set provided by
-C<ExtUtils::Manifest>, which is ignored if you provide your own
-F<MANIFEST.SKIP> file.
-
-If you are using C<Module::Build>, you should have two extra entries:
-
- ^Build$
- ^_build/
-
-If you don't have the correct entries, C<Module::Signature> will
-complain that you have:
-
- ==> MISMATCHED content between MANIFEST and distribution files! <==
-
-You should note this during normal development testing anyway.
-
-=head2 Testing signatures
-
-You may add this code as F<t/0-signature.t> in your distribution tree:
-
- #!/usr/bin/perl
-
- use strict;
- print "1..1\n";
-
- if (!$ENV{TEST_SIGNATURE}) {
- print "ok 1 # skip Set the environment variable",
- " TEST_SIGNATURE to enable this test\n";
- }
- elsif (!-s 'SIGNATURE') {
- print "ok 1 # skip No signature file found\n";
- }
- elsif (!eval { require Module::Signature; 1 }) {
- print "ok 1 # skip ",
- "Next time around, consider install Module::Signature, ",
- "so you can verify the integrity of this distribution.\n";
- }
- elsif (!eval { require Socket; Socket::inet_aton('pgp.mit.edu') }) {
- print "ok 1 # skip ",
- "Cannot connect to the keyserver\n";
- }
- else {
- (Module::Signature::verify() == Module::Signature::SIGNATURE_OK())
- or print "not ";
- print "ok 1 # Valid signature\n";
- }
-
- __END__
-
-If you are already using B<Test::More> for testing, a more
-straightforward version of F<t/0-signature.t> can be found in the
-B<Module::Signature> distribution.
-
-Also, if you prefer a more full-fledged testing package, and are
-willing to inflict the dependency of B<Module::Build> on your users,
-Iain Truskett's B<Test::Signature> might be a better choice.
-
-=cut
-
-=head1 SEE ALSO
-
-L<Digest>, L<Digest::SHA>, L<Digest::SHA1>, L<Digest::SHA::PurePerl>
-
-L<ExtUtils::Manifest>, L<Crypt::OpenPGP>, L<Test::Signature>
-
-L<Module::Install>, L<ExtUtils::MakeMaker>, L<Module::Build>
-
-=head1 AUTHORS
-
-Audrey Tang E<lt>cpan@audreyt.orgE<gt>
-
-=head1 COPYRIGHT (The "MIT" License)
-
-Copyright 2002-2006 by Audrey Tang E<lt>cpan@audreyt.orgE<gt>.
-
-Permission is hereby granted, free of charge, to any person obtaining a copy
-of this software and associated documentation files (the "Software"), to deal
-in the Software without restriction, including without limitation the rights
-to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
-copies of the Software, and to permit persons to whom the Software is fur-
-nished to do so, subject to the following conditions:
-
-The above copyright notice and this permission notice shall be included in
-all copies or substantial portions of the Software.
-
-THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
-IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FIT-
-NESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE X
-CONSORTIUM BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN
-ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
-WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
-
-=cut
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Net/HTTP.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Net/HTTP.pm
deleted file mode 100644
index 1c8d2ffdf40..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Net/HTTP.pm
+++ /dev/null
@@ -1,276 +0,0 @@
-package Net::HTTP;
-
-use strict;
-use vars qw($VERSION @ISA);
-
-$VERSION = "5.812";
-eval { require IO::Socket::INET } || require IO::Socket;
-require Net::HTTP::Methods;
-require Carp;
-
-@ISA=qw(IO::Socket::INET 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;
-
-__END__
-
-=head1 NAME
-
-Net::HTTP - Low-level HTTP connection (client)
-
-=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
-support C<HTTP/1.0> and C<HTTP/1.1>.
-
-C<Net::HTTP> is a sub-class of C<IO::Socket::INET>. 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<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. If the C<Compress::Zlib> module is installed then this will
-announce that this client accept both the I<deflate> and I<gzip>
-encodings.
-
-=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 4096. A value of 0 means no limit.
-
-=item $s->max_header_length
-
-Get/set a limit on the number of headers 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 COPYRIGHT
-
-Copyright 2001-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/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Net/HTTP/Methods.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Net/HTTP/Methods.pm
deleted file mode 100644
index 5d4d033dfdf..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Net/HTTP/Methods.pm
+++ /dev/null
@@ -1,558 +0,0 @@
-package Net::HTTP::Methods;
-
-require 5.005; # 4-arg substr
-
-use strict;
-use vars qw($VERSION);
-
-$VERSION = "5.812";
-
-my $CRLF = "\015\012"; # "\r\n" is not portable
-
-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 $explict_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;
- }
-
- if ($peer =~ s,:(\d+)$,,) {
- $cnf->{PeerPort} = int($1); # always override
- }
- if (!$cnf->{PeerPort}) {
- $cnf->{PeerPort} = $self->http_default_port;
- }
-
- if (!$explict_host) {
- $host = $peer;
- $host =~ s/:.*//;
- }
- if ($host && $host !~ /:/) {
- my $p = $cnf->{PeerPort};
- $host .= ":$p" if $p != $self->http_default_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 = 4*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 && zlib_ok()) {
- # gzip is less wanted since the Compress::Zlib 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 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 sprintf("%x", length($_[0])) . $CRLF . $_[0] . $CRLF;
-}
-
-sub write_chunk {
- my $self = shift;
- return 1 unless defined($_[0]) && length($_[0]);
- $self->print(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 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 {
- return $self->sysread($_[0], $len);
- }
- }
-}
-
-
-sub my_readline {
- my $self = 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 "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
- READ:
- {
- my $n = $self->sysread($_, 1024, length);
- unless (defined $n) {
- redo READ if $!{EINTR};
- if ($!{EAGAIN}) {
- # Hmm, we must be reading from a non-blocking socket
- # XXX Should really wait until this socket is readable,...
- select(undef, undef, undef, 0.1); # but this will do for now
- redo READ;
- }
- # if we have already accumulated some data let's at least
- # return that as a line
- die "read failed: $!" unless length;
- }
- unless ($n) {
- return undef unless length;
- return substr($_, 0, length, "");
- }
- }
- }
- die "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 _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)) {
- 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);
- 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";
-
- for (@te) {
- if ($_ eq "deflate" && zlib_ok()) {
- #require Compress::Zlib;
- my $i = Compress::Zlib::inflateInit();
- die "Can't make inflator" unless $i;
- $_ = sub { scalar($i->inflate($_[0])) }
- }
- elsif ($_ eq "gzip" && zlib_ok()) {
- #require Compress::Zlib;
- my @buf;
- $_ = sub {
- push(@buf, $_[0]);
- return Compress::Zlib::memGunzip(join("", @buf)) if $_[1];
- return "";
- };
- }
- 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);
- if ($chunked == 0) {
- die "Missing newline after chunk data: '$line'"
- if !defined($line) || $line ne "";
- $line = my_readline($self);
- }
- 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);
- 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);
- return undef unless defined $n;
- ${*$self}{'http_bytes'} = $bytes - $n;
- 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 $zlib_ok;
-
-sub zlib_ok {
- return $zlib_ok if defined $zlib_ok;
-
- # Try to load Compress::Zlib.
- local $@;
- local $SIG{__DIE__};
- $zlib_ok = 0;
-
- eval {
- require Compress::Zlib;
- Compress::Zlib->VERSION(1.10);
- $zlib_ok++;
- };
-
- return $zlib_ok;
-}
-
-} # BEGIN
-
-1;
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Net/HTTP/NB.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Net/HTTP/NB.pm
deleted file mode 100644
index e4145116f6a..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Net/HTTP/NB.pm
+++ /dev/null
@@ -1,105 +0,0 @@
-package Net::HTTP::NB;
-
-use strict;
-use vars qw($VERSION @ISA);
-
-$VERSION = "5.810";
-
-require Net::HTTP;
-@ISA=qw(Net::HTTP);
-
-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 tranforms
- my $n = eval { $self->SUPER::read_entity_body(@_); };
- if ($@) {
- $_[0] = "";
- return -1;
- }
- return $n;
-}
-
-1;
-
-__END__
-
-=head1 NAME
-
-Net::HTTP::NB - Non-blocking HTTP client
-
-=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 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/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Net/HTTPS.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Net/HTTPS.pm
deleted file mode 100644
index 6c7cacc000b..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Net/HTTPS.pm
+++ /dev/null
@@ -1,56 +0,0 @@
-package Net::HTTPS;
-
-use strict;
-use vars qw($VERSION $SSL_SOCKET_CLASS @ISA);
-
-$VERSION = "5.810";
-
-# Figure out which SSL implementation to use
-if ($Net::SSL::VERSION) {
- $SSL_SOCKET_CLASS = "Net::SSL";
-}
-elsif ($IO::Socket::SSL::VERSION) {
- $SSL_SOCKET_CLASS = "IO::Socket::SSL"; # it was already loaded
-}
-else {
- eval { require Net::SSL; }; # from Crypt-SSLeay
- if ($@) {
- my $old_errsv = $@;
- eval {
- require IO::Socket::SSL;
- };
- if ($@) {
- $old_errsv =~ s/\s\(\@INC contains:.*\)/)/g;
- die $old_errsv . $@;
- }
- $SSL_SOCKET_CLASS = "IO::Socket::SSL";
- }
- else {
- $SSL_SOCKET_CLASS = "Net::SSL";
- }
-}
-
-require Net::HTTP::Methods;
-
-@ISA=($SSL_SOCKET_CLASS, 'Net::HTTP::Methods');
-
-sub configure {
- my($self, $cnf) = @_;
- $self->http_configure($cnf);
-}
-
-sub http_connect {
- my($self, $cnf) = @_;
- $self->SUPER::configure($cnf);
-}
-
-sub http_default_port {
- 443;
-}
-
-# 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.
-sub blocking { } # noop
-
-1;
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Net/Telnet.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Net/Telnet.pm
deleted file mode 100644
index 5fa41ce31d5..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Net/Telnet.pm
+++ /dev/null
@@ -1,5252 +0,0 @@
-package Net::Telnet;
-
-## Copyright 1997, 2000, 2002 Jay Rogers. All rights reserved.
-## This program is free software; you can redistribute it and/or
-## modify it under the same terms as Perl itself.
-
-## See user documentation at the end of this file. Search for =head
-
-use strict;
-require 5.002;
-
-## Module export.
-use vars qw(@EXPORT_OK);
-@EXPORT_OK = qw(TELNET_IAC TELNET_DONT TELNET_DO TELNET_WONT TELNET_WILL
- TELNET_SB TELNET_GA TELNET_EL TELNET_EC TELNET_AYT TELNET_AO
- TELNET_IP TELNET_BREAK TELNET_DM TELNET_NOP TELNET_SE
- TELNET_EOR TELNET_ABORT TELNET_SUSP TELNET_EOF TELNET_SYNCH
- TELOPT_BINARY TELOPT_ECHO TELOPT_RCP TELOPT_SGA TELOPT_NAMS
- TELOPT_STATUS TELOPT_TM TELOPT_RCTE TELOPT_NAOL TELOPT_NAOP
- TELOPT_NAOCRD TELOPT_NAOHTS TELOPT_NAOHTD TELOPT_NAOFFD
- TELOPT_NAOVTS TELOPT_NAOVTD TELOPT_NAOLFD TELOPT_XASCII
- TELOPT_LOGOUT TELOPT_BM TELOPT_DET TELOPT_SUPDUP
- TELOPT_SUPDUPOUTPUT TELOPT_SNDLOC TELOPT_TTYPE TELOPT_EOR
- TELOPT_TUID TELOPT_OUTMRK TELOPT_TTYLOC TELOPT_3270REGIME
- TELOPT_X3PAD TELOPT_NAWS TELOPT_TSPEED TELOPT_LFLOW
- TELOPT_LINEMODE TELOPT_XDISPLOC TELOPT_OLD_ENVIRON
- TELOPT_AUTHENTICATION TELOPT_ENCRYPT TELOPT_NEW_ENVIRON
- TELOPT_EXOPL);
-
-## Module import.
-use Exporter ();
-use Socket qw(AF_INET SOCK_STREAM inet_aton sockaddr_in);
-use Symbol qw(qualify);
-
-## Base classes.
-use vars qw(@ISA);
-@ISA = qw(Exporter);
-if (&_io_socket_include) { # successfully required module IO::Socket
- push @ISA, "IO::Socket::INET";
-}
-else { # perl version < 5.004
- require FileHandle;
- push @ISA, "FileHandle";
-}
-
-## Global variables.
-use vars qw($VERSION @Telopts);
-$VERSION = "3.03";
-@Telopts = ("BINARY", "ECHO", "RCP", "SUPPRESS GO AHEAD", "NAME", "STATUS",
- "TIMING MARK", "RCTE", "NAOL", "NAOP", "NAOCRD", "NAOHTS",
- "NAOHTD", "NAOFFD", "NAOVTS", "NAOVTD", "NAOLFD", "EXTEND ASCII",
- "LOGOUT", "BYTE MACRO", "DATA ENTRY TERMINAL", "SUPDUP",
- "SUPDUP OUTPUT", "SEND LOCATION", "TERMINAL TYPE", "END OF RECORD",
- "TACACS UID", "OUTPUT MARKING", "TTYLOC", "3270 REGIME", "X.3 PAD",
- "NAWS", "TSPEED", "LFLOW", "LINEMODE", "XDISPLOC", "OLD-ENVIRON",
- "AUTHENTICATION", "ENCRYPT", "NEW-ENVIRON");
-
-
-########################### Public Methods ###########################
-
-
-sub new {
- my ($class) = @_;
- my (
- $errmode,
- $fh_open,
- $host,
- $self,
- %args,
- );
- local $_;
-
- ## Create a new object with defaults.
- $self = $class->SUPER::new;
- *$self->{net_telnet} = {
- bin_mode => 0,
- blksize => &_optimal_blksize(),
- buf => "",
- cmd_prompt => '/[\$%#>] $/',
- cmd_rm_mode => "auto",
- dumplog => '',
- eofile => 1,
- errormode => "die",
- errormsg => "",
- fdmask => '',
- host => "localhost",
- inputlog => '',
- last_line => "",
- last_prompt => "",
- maxbufsize => 1_048_576,
- num_wrote => 0,
- ofs => "",
- opened => '',
- opt_cback => '',
- opt_log => '',
- opts => {},
- ors => "\n",
- outputlog => '',
- pending_errormsg => "",
- port => 23,
- pushback_buf => "",
- rs => "\n",
- subopt_cback => '',
- telnet_mode => 1,
- time_out => 10,
- timedout => '',
- unsent_opts => "",
- };
-
- ## Indicate that we'll accept an offer from remote side for it to echo
- ## and suppress go aheads.
- &_opt_accept($self,
- { option => &TELOPT_ECHO,
- is_remote => 1,
- is_enable => 1 },
- { option => &TELOPT_SGA,
- is_remote => 1,
- is_enable => 1 },
- );
-
- ## Parse the args.
- if (@_ == 2) { # one positional arg given
- $host = $_[1];
- }
- elsif (@_ > 2) { # named args given
- ## Get the named args.
- (undef, %args) = @_;
-
- ## Parse all other named args.
- foreach (keys %args) {
- if (/^-?binmode$/i) {
- $self->binmode($args{$_});
- }
- elsif (/^-?cmd_remove_mode$/i) {
- $self->cmd_remove_mode($args{$_});
- }
- elsif (/^-?dump_log$/i) {
- $self->dump_log($args{$_});
- }
- elsif (/^-?errmode$/i) {
- $errmode = $args{$_};
- }
- elsif (/^-?fhopen$/i) {
- $fh_open = $args{$_};
- }
- elsif (/^-?host$/i) {
- $host = $args{$_};
- }
- elsif (/^-?input_log$/i) {
- $self->input_log($args{$_});
- }
- elsif (/^-?input_record_separator$/i or /^-?rs$/i) {
- $self->input_record_separator($args{$_});
- }
- elsif (/^-?option_log$/i) {
- $self->option_log($args{$_});
- }
- elsif (/^-?output_log$/i) {
- $self->output_log($args{$_});
- }
- elsif (/^-?output_record_separator$/i or /^-?ors$/i) {
- $self->output_record_separator($args{$_});
- }
- elsif (/^-?port$/i) {
- $self->port($args{$_});
- }
- elsif (/^-?prompt$/i) {
- $self->prompt($args{$_});
- }
- elsif (/^-?telnetmode$/i) {
- $self->telnetmode($args{$_});
- }
- elsif (/^-?timeout$/i) {
- $self->timeout($args{$_});
- }
- else {
- &_croak($self, "bad named parameter \"$_\" given " .
- "to " . ref($self) . "::new()");
- }
- }
- }
-
- if (defined $errmode) { # user wants to set errmode
- $self->errmode($errmode);
- }
-
- if (defined $fh_open) { # user wants us to attach to existing filehandle
- $self->fhopen($fh_open)
- or return;
- }
- elsif (defined $host) { # user wants us to open a connection to host
- $self->host($host);
- $self->open
- or return;
- }
-
- $self;
-} # end sub new
-
-
-sub DESTROY {
-} # end sub DESTROY
-
-
-sub binmode {
- my ($self, $mode) = @_;
- my (
- $prev,
- $s,
- );
-
- $s = *$self->{net_telnet};
- $prev = $s->{bin_mode};
-
- if (@_ >= 2) {
- unless (defined $mode) {
- $mode = 0;
- }
-
- $s->{bin_mode} = $mode;
- }
-
- $prev;
-} # end sub binmode
-
-
-sub break {
- my ($self) = @_;
- my $s = *$self->{net_telnet};
- my $break_cmd = "\xff\xf3";
-
- $s->{timedout} = '';
-
- &_put($self, \$break_cmd, "break");
-} # end sub break
-
-
-sub buffer {
- my ($self) = @_;
- my $s = *$self->{net_telnet};
-
- \$s->{buf};
-} # end sub buffer
-
-
-sub buffer_empty {
- my ($self) = @_;
- my (
- $buffer,
- );
-
- $buffer = $self->buffer;
- $$buffer = "";
-} # end sub buffer_empty
-
-
-sub close {
- my ($self) = @_;
- my $s = *$self->{net_telnet};
-
- $s->{eofile} = 1;
- $s->{opened} = '';
- close $self
- if defined fileno($self);
-
- 1;
-} # end sub close
-
-
-sub cmd {
- my ($self, @args) = @_;
- my (
- $cmd_remove_mode,
- $errmode,
- $firstpos,
- $last_prompt,
- $lastpos,
- $lines,
- $ors,
- $output,
- $output_ref,
- $prompt,
- $remove_echo,
- $rs,
- $rs_len,
- $s,
- $telopt_echo,
- $timeout,
- %args,
- );
- my $cmd = "";
- local $_;
-
- ## Init.
- $self->timed_out('');
- $self->last_prompt("");
- $s = *$self->{net_telnet};
- $output = [];
- $cmd_remove_mode = $self->cmd_remove_mode;
- $errmode = $self->errmode;
- $ors = $self->output_record_separator;
- $prompt = $self->prompt;
- $rs = $self->input_record_separator;
- $timeout = $self->timeout;
-
- ## Parse args.
- if (@_ == 2) { # one positional arg given
- $cmd = $_[1];
- }
- elsif (@_ > 2) { # named args given
- ## Get the named args.
- (undef, %args) = @_;
-
- ## Parse the named args.
- foreach (keys %args) {
- if (/^-?cmd_remove/i) {
- $cmd_remove_mode = &_parse_cmd_remove_mode($self, $args{$_});
- }
- elsif (/^-?errmode$/i) {
- $errmode = &_parse_errmode($self, $args{$_});
- }
- elsif (/^-?input_record_separator$/i or /^-?rs$/i) {
- $rs = &_parse_input_record_separator($self, $args{$_});
- }
- elsif (/^-?output$/i) {
- $output_ref = $args{$_};
- if (defined($output_ref) and ref($output_ref) eq "ARRAY") {
- $output = $output_ref;
- }
- }
- elsif (/^-?output_record_separator$/i or /^-?ors$/i) {
- $ors = $self->output_record_separator($args{$_});
- }
- elsif (/^-?prompt$/i) {
- $prompt = &_parse_prompt($self, $args{$_});
- }
- elsif (/^-?string$/i) {
- $cmd = $args{$_};
- }
- elsif (/^-?timeout$/i) {
- $timeout = &_parse_timeout($self, $args{$_});
- }
- else {
- &_croak($self, "bad named parameter \"$_\" given " .
- "to " . ref($self) . "::cmd()");
- }
- }
- }
-
- ## Override some user settings.
- local $s->{errormode} = "return";
- local $s->{time_out} = &_endtime($timeout);
- $self->errmsg("");
-
- ## Send command and wait for the prompt.
- $self->put($cmd . $ors)
- and ($lines, $last_prompt) = $self->waitfor($prompt);
-
- ## Check for failure.
- $s->{errormode} = $errmode;
- return $self->error("command timed-out") if $self->timed_out;
- return $self->error($self->errmsg) if $self->errmsg ne "";
-
- ## Save the most recently matched prompt.
- $self->last_prompt($last_prompt);
-
- ## Split lines into an array, keeping record separator at end of line.
- $firstpos = 0;
- $rs_len = length $rs;
- while (($lastpos = index($lines, $rs, $firstpos)) > -1) {
- push(@$output,
- substr($lines, $firstpos, $lastpos - $firstpos + $rs_len));
- $firstpos = $lastpos + $rs_len;
- }
-
- if ($firstpos < length $lines) {
- push @$output, substr($lines, $firstpos);
- }
-
- ## Determine if we should remove the first line of output based
- ## on the assumption that it's an echoed back command.
- if ($cmd_remove_mode eq "auto") {
- ## See if remote side told us they'd echo.
- $telopt_echo = $self->option_state(&TELOPT_ECHO);
- $remove_echo = $telopt_echo->{remote_enabled};
- }
- else { # user explicitly told us how many lines to remove.
- $remove_echo = $cmd_remove_mode;
- }
-
- ## Get rid of possible echo back command.
- while ($remove_echo--) {
- shift @$output;
- }
-
- ## Ensure at least a null string when there's no command output - so
- ## "true" is returned in a list context.
- unless (@$output) {
- @$output = ("");
- }
-
- ## Return command output via named arg, if requested.
- if (defined $output_ref) {
- if (ref($output_ref) eq "SCALAR") {
- $$output_ref = join "", @$output;
- }
- elsif (ref($output_ref) eq "HASH") {
- %$output_ref = @$output;
- }
- }
-
- wantarray ? @$output : 1;
-} # end sub cmd
-
-
-sub cmd_remove_mode {
- my ($self, $mode) = @_;
- my (
- $prev,
- $s,
- );
-
- $s = *$self->{net_telnet};
- $prev = $s->{cmd_rm_mode};
-
- if (@_ >= 2) {
- $s->{cmd_rm_mode} = &_parse_cmd_remove_mode($self, $mode);
- }
-
- $prev;
-} # end sub cmd_remove_mode
-
-
-sub dump_log {
- my ($self, $name) = @_;
- my (
- $fh,
- $s,
- );
-
- $s = *$self->{net_telnet};
- $fh = $s->{dumplog};
-
- if (@_ >= 2) {
- unless (defined $name) {
- $name = "";
- }
-
- $fh = &_fname_to_handle($self, $name)
- or return;
- $s->{dumplog} = $fh;
- }
-
- $fh;
-} # end sub dump_log
-
-
-sub eof {
- my ($self) = @_;
-
- *$self->{net_telnet}{eofile};
-} # end sub eof
-
-
-sub errmode {
- my ($self, $mode) = @_;
- my (
- $prev,
- $s,
- );
-
- $s = *$self->{net_telnet};
- $prev = $s->{errormode};
-
- if (@_ >= 2) {
- $s->{errormode} = &_parse_errmode($self, $mode);
- }
-
- $prev;
-} # end sub errmode
-
-
-sub errmsg {
- my ($self, @errmsgs) = @_;
- my (
- $prev,
- $s,
- );
-
- $s = *$self->{net_telnet};
- $prev = $s->{errormsg};
-
- if (@_ >= 2) {
- $s->{errormsg} = join "", @errmsgs;
- }
-
- $prev;
-} # end sub errmsg
-
-
-sub error {
- my ($self, @errmsg) = @_;
- my (
- $errmsg,
- $func,
- $mode,
- $s,
- @args,
- );
- local $_;
-
- $s = *$self->{net_telnet};
-
- if (@_ >= 2) {
- ## Put error message in the object.
- $errmsg = join "", @errmsg;
- $s->{errormsg} = $errmsg;
-
- ## Do the error action as described by error mode.
- $mode = $s->{errormode};
- if (ref($mode) eq "CODE") {
- &$mode($errmsg);
- return;
- }
- elsif (ref($mode) eq "ARRAY") {
- ($func, @args) = @$mode;
- &$func(@args);
- return;
- }
- elsif ($mode =~ /^return$/i) {
- return;
- }
- else { # die
- if ($errmsg =~ /\n$/) {
- die $errmsg;
- }
- else {
- ## Die and append caller's line number to message.
- &_croak($self, $errmsg);
- }
- }
- }
- else {
- return $s->{errormsg} ne "";
- }
-} # end sub error
-
-
-sub fhopen {
- my ($self, $fh) = @_;
- my (
- $globref,
- $s,
- );
-
- ## Convert given filehandle to a typeglob reference, if necessary.
- $globref = &_qualify_fh($self, $fh);
-
- ## Ensure filehandle is already open.
- return $self->error("fhopen filehandle isn't already open")
- unless defined($globref) and defined(fileno $globref);
-
- ## Ensure we're closed.
- $self->close;
-
- ## Save our private data.
- $s = *$self->{net_telnet};
-
- ## Switch ourself with the given filehandle.
- *$self = *$globref;
-
- ## Restore our private data.
- *$self->{net_telnet} = $s;
-
- ## Re-initialize ourself.
- select((select($self), $|=1)[$[]); # don't buffer writes
- $s = *$self->{net_telnet};
- $s->{blksize} = &_optimal_blksize((stat $self)[11]);
- $s->{buf} = "";
- $s->{eofile} = '';
- $s->{errormsg} = "";
- vec($s->{fdmask}='', fileno($self), 1) = 1;
- $s->{host} = "";
- $s->{last_line} = "";
- $s->{last_prompt} = "";
- $s->{num_wrote} = 0;
- $s->{opened} = 1;
- $s->{pending_errormsg} = "";
- $s->{port} = '';
- $s->{pushback_buf} = "";
- $s->{timedout} = '';
- $s->{unsent_opts} = "";
- &_reset_options($s->{opts});
-
- 1;
-} # end sub fhopen
-
-
-sub get {
- my ($self, %args) = @_;
- my (
- $binmode,
- $endtime,
- $errmode,
- $line,
- $s,
- $telnetmode,
- $timeout,
- );
- local $_;
-
- ## Init.
- $s = *$self->{net_telnet};
- $timeout = $s->{time_out};
- $s->{timedout} = '';
- return if $s->{eofile};
-
- ## Parse the named args.
- foreach (keys %args) {
- if (/^-?binmode$/i) {
- $binmode = $args{$_};
- unless (defined $binmode) {
- $binmode = 0;
- }
- }
- elsif (/^-?errmode$/i) {
- $errmode = &_parse_errmode($self, $args{$_});
- }
- elsif (/^-?telnetmode$/i) {
- $telnetmode = $args{$_};
- unless (defined $telnetmode) {
- $telnetmode = 0;
- }
- }
- elsif (/^-?timeout$/i) {
- $timeout = &_parse_timeout($self, $args{$_});
- }
- else {
- &_croak($self, "bad named parameter \"$_\" given " .
- "to " . ref($self) . "::get()");
- }
- }
-
- ## If any args given, override corresponding instance data.
- local $s->{errormode} = $errmode
- if defined $errmode;
- local $s->{bin_mode} = $binmode
- if defined $binmode;
- local $s->{telnet_mode} = $telnetmode
- if defined $telnetmode;
-
- ## Set wall time when we time out.
- $endtime = &_endtime($timeout);
-
- ## Try to send any waiting option negotiation.
- if (length $s->{unsent_opts}) {
- &_flush_opts($self);
- }
-
- ## Try to read just the waiting data using return error mode.
- {
- local $s->{errormode} = "return";
- $s->{errormsg} = "";
- &_fillbuf($self, $s, 0);
- }
-
- ## We're done if we timed-out and timeout value is set to "poll".
- return $self->error($s->{errormsg})
- if ($s->{timedout} and defined($timeout) and $timeout == 0
- and !length $s->{buf});
-
- ## We're done if we hit an error other than timing out.
- if ($s->{errormsg} and !$s->{timedout}) {
- if (!length $s->{buf}) {
- return $self->error($s->{errormsg});
- }
- else { # error encountered but there's some data in buffer
- $s->{pending_errormsg} = $s->{errormsg};
- }
- }
-
- ## Clear time-out error from first read.
- $s->{timedout} = '';
- $s->{errormsg} = "";
-
- ## If buffer is still empty, try to read according to user's timeout.
- if (!length $s->{buf}) {
- &_fillbuf($self, $s, $endtime)
- or do {
- return if $s->{timedout};
-
- ## We've reached end-of-file.
- $self->close;
- return;
- };
- }
-
- ## Extract chars from buffer.
- $line = $s->{buf};
- $s->{buf} = "";
-
- $line;
-} # end sub get
-
-
-sub getline {
- my ($self, %args) = @_;
- my (
- $binmode,
- $endtime,
- $errmode,
- $len,
- $line,
- $offset,
- $pos,
- $rs,
- $s,
- $telnetmode,
- $timeout,
- );
- local $_;
-
- ## Init.
- $s = *$self->{net_telnet};
- $s->{timedout} = '';
- return if $s->{eofile};
- $rs = $s->{rs};
- $timeout = $s->{time_out};
-
- ## Parse the named args.
- foreach (keys %args) {
- if (/^-?binmode$/i) {
- $binmode = $args{$_};
- unless (defined $binmode) {
- $binmode = 0;
- }
- }
- elsif (/^-?errmode$/i) {
- $errmode = &_parse_errmode($self, $args{$_});
- }
- elsif (/^-?input_record_separator$/i or /^-?rs$/i) {
- $rs = &_parse_input_record_separator($self, $args{$_});
- }
- elsif (/^-?telnetmode$/i) {
- $telnetmode = $args{$_};
- unless (defined $telnetmode) {
- $telnetmode = 0;
- }
- }
- elsif (/^-?timeout$/i) {
- $timeout = &_parse_timeout($self, $args{$_});
- }
- else {
- &_croak($self, "bad named parameter \"$_\" given " .
- "to " . ref($self) . "::getline()");
- }
- }
-
- ## If any args given, override corresponding instance data.
- local $s->{bin_mode} = $binmode
- if defined $binmode;
- local $s->{errormode} = $errmode
- if defined $errmode;
- local $s->{telnet_mode} = $telnetmode
- if defined $telnetmode;
-
- ## Set wall time when we time out.
- $endtime = &_endtime($timeout);
-
- ## Try to send any waiting option negotiation.
- if (length $s->{unsent_opts}) {
- &_flush_opts($self);
- }
-
- ## Keep reading into buffer until end-of-line is read.
- $offset = 0;
- while (($pos = index($s->{buf}, $rs, $offset)) == -1) {
- $offset = length $s->{buf};
- &_fillbuf($self, $s, $endtime)
- or do {
- return if $s->{timedout};
-
- ## We've reached end-of-file.
- $self->close;
- if (length $s->{buf}) {
- return $s->{buf};
- }
- else {
- return;
- }
- };
- }
-
- ## Extract line from buffer.
- $len = $pos + length $rs;
- $line = substr($s->{buf}, 0, $len);
- substr($s->{buf}, 0, $len) = "";
-
- $line;
-} # end sub getline
-
-
-sub getlines {
- my ($self, %args) = @_;
- my (
- $binmode,
- $errmode,
- $line,
- $rs,
- $s,
- $telnetmode,
- $timeout,
- );
- my $all = 1;
- my @lines = ();
- local $_;
-
- ## Init.
- $s = *$self->{net_telnet};
- $s->{timedout} = '';
- return if $s->{eofile};
- $timeout = $s->{time_out};
-
- ## Parse the named args.
- foreach (keys %args) {
- if (/^-?all$/i) {
- $all = $args{$_};
- unless (defined $all) {
- $all = '';
- }
- }
- elsif (/^-?binmode$/i) {
- $binmode = $args{$_};
- unless (defined $binmode) {
- $binmode = 0;
- }
- }
- elsif (/^-?errmode$/i) {
- $errmode = &_parse_errmode($self, $args{$_});
- }
- elsif (/^-?input_record_separator$/i or /^-?rs$/i) {
- $rs = &_parse_input_record_separator($self, $args{$_});
- }
- elsif (/^-?telnetmode$/i) {
- $telnetmode = $args{$_};
- unless (defined $telnetmode) {
- $telnetmode = 0;
- }
- }
- elsif (/^-?timeout$/i) {
- $timeout = &_parse_timeout($self, $args{$_});
- }
- else {
- &_croak($self, "bad named parameter \"$_\" given " .
- "to " . ref($self) . "::getlines()");
- }
- }
-
- ## If any args given, override corresponding instance data.
- local $s->{bin_mode} = $binmode
- if defined $binmode;
- local $s->{errormode} = $errmode
- if defined $errmode;
- local $s->{rs} = $rs
- if defined $rs;
- local $s->{telnet_mode} = $telnetmode
- if defined $telnetmode;
- local $s->{time_out} = &_endtime($timeout);
-
- ## User requested only the currently available lines.
- if (! $all) {
- return &_next_getlines($self, $s);
- }
-
- ## Read lines until eof or error.
- while (1) {
- $line = $self->getline
- or last;
- push @lines, $line;
- }
-
- ## Check for error.
- return if ! $self->eof;
-
- @lines;
-} # end sub getlines
-
-
-sub host {
- my ($self, $host) = @_;
- my (
- $prev,
- $s,
- );
-
- $s = *$self->{net_telnet};
- $prev = $s->{host};
-
- if (@_ >= 2) {
- unless (defined $host) {
- $host = "";
- }
-
- $s->{host} = $host;
- }
-
- $prev;
-} # end sub host
-
-
-sub input_log {
- my ($self, $name) = @_;
- my (
- $fh,
- $s,
- );
-
- $s = *$self->{net_telnet};
- $fh = $s->{inputlog};
-
- if (@_ >= 2) {
- unless (defined $name) {
- $name = "";
- }
-
- $fh = &_fname_to_handle($self, $name)
- or return;
- $s->{inputlog} = $fh;
- }
-
- $fh;
-} # end sub input_log
-
-
-sub input_record_separator {
- my ($self, $rs) = @_;
- my (
- $prev,
- $s,
- );
-
- $s = *$self->{net_telnet};
- $prev = $s->{rs};
-
- if (@_ >= 2) {
- $s->{rs} = &_parse_input_record_separator($self, $rs);
- }
-
- $prev;
-} # end sub input_record_separator
-
-
-sub last_prompt {
- my ($self, $string) = @_;
- my (
- $prev,
- $s,
- );
-
- $s = *$self->{net_telnet};
- $prev = $s->{last_prompt};
-
- if (@_ >= 2) {
- unless (defined $string) {
- $string = "";
- }
-
- $s->{last_prompt} = $string;
- }
-
- $prev;
-} # end sub last_prompt
-
-
-sub lastline {
- my ($self, $line) = @_;
- my (
- $prev,
- $s,
- );
-
- $s = *$self->{net_telnet};
- $prev = $s->{last_line};
-
- if (@_ >= 2) {
- unless (defined $line) {
- $line = "";
- }
-
- $s->{last_line} = $line;
- }
-
- $prev;
-} # end sub lastline
-
-
-sub login {
- my ($self) = @_;
- my (
- $errmode,
- $error,
- $is_passwd_arg,
- $is_username_arg,
- $lastline,
- $match,
- $ors,
- $passwd,
- $prematch,
- $prompt,
- $s,
- $timeout,
- $username,
- %args,
- );
- local $_;
-
- ## Init.
- $self->timed_out('');
- $self->last_prompt("");
- $s = *$self->{net_telnet};
- $timeout = $self->timeout;
- $ors = $self->output_record_separator;
- $prompt = $self->prompt;
-
- ## Parse args.
- if (@_ == 3) { # just username and passwd given
- $username = $_[1];
- $passwd = $_[2];
-
- $is_username_arg = 1;
- $is_passwd_arg = 1;
- }
- else { # named args given
- ## Get the named args.
- (undef, %args) = @_;
-
- ## Parse the named args.
- foreach (keys %args) {
- if (/^-?errmode$/i) {
- $errmode = &_parse_errmode($self, $args{$_});
- }
- elsif (/^-?name$/i) {
- $username = $args{$_};
- unless (defined $username) {
- $username = "";
- }
-
- $is_username_arg = 1;
- }
- elsif (/^-?pass/i) {
- $passwd = $args{$_};
- unless (defined $passwd) {
- $passwd = "";
- }
-
- $is_passwd_arg = 1;
- }
- elsif (/^-?prompt$/i) {
- $prompt = &_parse_prompt($self, $args{$_});
- }
- elsif (/^-?timeout$/i) {
- $timeout = &_parse_timeout($self, $args{$_});
- }
- else {
- &_croak($self, "bad named parameter \"$_\" given ",
- "to " . ref($self) . "::login()");
- }
- }
- }
-
- ## Ensure both username and password argument given.
- &_croak($self,"Name argument not given to " . ref($self) . "::login()")
- unless $is_username_arg;
- &_croak($self,"Password argument not given to " . ref($self) . "::login()")
- unless $is_passwd_arg;
-
- ## Override some user settings.
- local $s->{errormode} = $errmode
- if defined $errmode;
- local $s->{time_out} = &_endtime($timeout);
-
- ## Create a subroutine to generate an error.
- $error
- = sub {
- my ($errmsg) = @_;
-
- if ($self->timed_out) {
- return $self->error($errmsg);
- }
- elsif ($self->eof) {
- ($lastline = $self->lastline) =~ s/\n+//;
- return $self->error($errmsg, ": ", $lastline);
- }
- else {
- return $self->error($self->errmsg);
- }
- };
-
-
- return $self->error("login failed: filehandle isn't open")
- if $self->eof;
-
- ## Wait for login prompt.
- $self->waitfor(Match => '/login[: ]*$/i',
- Match => '/username[: ]*$/i',
- Errmode => "return")
- or do {
- return &$error("eof read waiting for login prompt")
- if $self->eof;
- return &$error("timed-out waiting for login prompt");
- };
-
- ## Delay sending response because of bug in Linux login program.
- &_sleep(0.01);
-
- ## Send login name.
- $self->put(String => $username . $ors,
- Errmode => "return")
- or return &$error("login disconnected");
-
- ## Wait for password prompt.
- $self->waitfor(Match => '/password[: ]*$/i',
- Errmode => "return")
- or do {
- return &$error("eof read waiting for password prompt")
- if $self->eof;
- return &$error("timed-out waiting for password prompt");
- };
-
- ## Delay sending response because of bug in Linux login program.
- &_sleep(0.01);
-
- ## Send password.
- $self->put(String => $passwd . $ors,
- Errmode => "return")
- or return &$error("login disconnected");
-
- ## Wait for command prompt or another login prompt.
- ($prematch, $match) = $self->waitfor(Match => '/login[: ]*$/i',
- Match => '/username[: ]*$/i',
- Match => $prompt,
- Errmode => "return")
- or do {
- return &$error("eof read waiting for command prompt")
- if $self->eof;
- return &$error("timed-out waiting for command prompt");
- };
-
- ## It's a bad login if we got another login prompt.
- return $self->error("login failed: bad name or password")
- if $match =~ /login[: ]*$/i or $match =~ /username[: ]*$/i;
-
- ## Save the most recently matched command prompt.
- $self->last_prompt($match);
-
- 1;
-} # end sub login
-
-
-sub max_buffer_length {
- my ($self, $maxbufsize) = @_;
- my (
- $prev,
- $s,
- );
- my $minbufsize = 512;
-
- $s = *$self->{net_telnet};
- $prev = $s->{maxbufsize};
-
- if (@_ >= 2) {
- ## Ensure a positive integer value.
- unless (defined $maxbufsize
- and $maxbufsize =~ /^\d+$/
- and $maxbufsize)
- {
- &_carp($self, "ignoring bad Max_buffer_length " .
- "argument \"$maxbufsize\": it's not a positive integer");
- $maxbufsize = $prev;
- }
-
- ## Adjust up values that are too small.
- if ($maxbufsize < $minbufsize) {
- $maxbufsize = $minbufsize;
- }
-
- $s->{maxbufsize} = $maxbufsize;
- }
-
- $prev;
-} # end sub max_buffer_length
-
-
-## Make ofs() synonymous with output_field_separator().
-*ofs = \&output_field_separator;
-
-
-sub open {
- my ($self) = @_;
- my (
- $errmode,
- $errno,
- $host,
- $ip_addr,
- $port,
- $s,
- $timeout,
- %args,
- );
- local $_;
-
- ## Init.
- $s = *$self->{net_telnet};
- $timeout = $s->{time_out};
- $s->{timedout} = '';
-
- if (@_ == 2) { # one positional arg given
- $self->host($_[1]);
- }
- elsif (@_ > 2) { # named args given
- ## Get the named args.
- (undef, %args) = @_;
-
- ## Parse the named args.
- foreach (keys %args) {
- if (/^-?errmode$/i) {
- $errmode = &_parse_errmode($self, $args{$_});
- }
- elsif (/^-?host$/i) {
- $self->host($args{$_});
- }
- elsif (/^-?port$/i) {
- $self->port($args{$_})
- or return;
- }
- elsif (/^-?timeout$/i) {
- $timeout = &_parse_timeout($self, $args{$_});
- }
- else {
- &_croak($self, "bad named parameter \"$_\" given ",
- "to " . ref($self) . "::open()");
- }
- }
- }
-
- ## If any args given, override corresponding instance data.
- local $s->{errormode} = $errmode
- if defined $errmode;
-
- ## Get host and port.
- $host = $self->host;
- $port = $self->port;
-
- ## Ensure we're already closed.
- $self->close;
-
- ## Connect with or without a timeout.
- if (defined($timeout) and &_have_alarm) { # use a timeout
- ## Convert possible absolute timeout to relative timeout.
- if ($timeout >= $^T) { # it's an absolute time
- $timeout = $timeout - time;
- }
-
- ## Ensure a valid timeout value for alarm.
- if ($timeout < 1) {
- $timeout = 1;
- }
- $timeout = int($timeout + 1.5);
-
- ## Connect to server, timing out if it takes too long.
- eval {
- ## Turn on timer.
- local $SIG{"__DIE__"} = "DEFAULT";
- local $SIG{ALRM} = sub { die "timed-out\n" };
- alarm $timeout;
-
- ## Lookup server's IP address.
- $ip_addr = inet_aton $host
- or die "unknown remote host: $host\n";
-
- ## Create a socket and attach the filehandle to it.
- socket $self, AF_INET, SOCK_STREAM, 0
- or die "problem creating socket: $!\n";
-
- ## Open connection to server.
- connect $self, sockaddr_in($port, $ip_addr)
- or die "problem connecting to \"$host\", port $port: $!\n";
- };
- alarm 0;
-
- ## Check for error.
- if ($@ =~ /^timed-out$/) { # time out failure
- $s->{timedout} = 1;
- $self->close;
- if (!$ip_addr) {
- return $self->error("unknown remote host: $host: ",
- "name lookup timed-out");
- }
- else {
- return $self->error("problem connecting to \"$host\", ",
- "port $port: connect timed-out");
- }
- }
- elsif ($@) { # hostname lookup or connect failure
- $self->close;
- chomp $@;
- return $self->error($@);
- }
- }
- else { # don't use a timeout
- $timeout = undef;
-
- ## Lookup server's IP address.
- $ip_addr = inet_aton $host
- or return $self->error("unknown remote host: $host");
-
- ## Create a socket and attach the filehandle to it.
- socket $self, AF_INET, SOCK_STREAM, 0
- or return $self->error("problem creating socket: $!");
-
- ## Open connection to server.
- connect $self, sockaddr_in($port, $ip_addr)
- or do {
- $errno = "$!";
- $self->close;
- return $self->error("problem connecting to \"$host\", ",
- "port $port: $errno");
- };
- }
-
- select((select($self), $|=1)[$[]); # don't buffer writes
- $s->{blksize} = &_optimal_blksize((stat $self)[11]);
- $s->{buf} = "";
- $s->{eofile} = '';
- $s->{errormsg} = "";
- vec($s->{fdmask}='', fileno($self), 1) = 1;
- $s->{last_line} = "";
- $s->{num_wrote} = 0;
- $s->{opened} = 1;
- $s->{pending_errormsg} = "";
- $s->{pushback_buf} = "";
- $s->{timedout} = '';
- $s->{unsent_opts} = "";
- &_reset_options($s->{opts});
-
- 1;
-} # end sub open
-
-
-sub option_accept {
- my ($self, @args) = @_;
- my (
- $arg,
- $option,
- $s,
- @opt_args,
- );
- local $_;
-
- ## Init.
- $s = *$self->{net_telnet};
-
- ## Parse the named args.
- while (($_, $arg) = splice @args, 0, 2) {
- ## Verify and save arguments.
- if (/^-?do$/i) {
- ## Make sure a callback is defined.
- return $self->error("usage: an option callback must already ",
- "be defined when enabling with $_")
- unless $s->{opt_cback};
-
- $option = &_verify_telopt_arg($self, $arg, $_);
- return unless defined $option;
- push @opt_args, { option => $option,
- is_remote => '',
- is_enable => 1,
- };
- }
- elsif (/^-?dont$/i) {
- $option = &_verify_telopt_arg($self, $arg, $_);
- return unless defined $option;
- push @opt_args, { option => $option,
- is_remote => '',
- is_enable => '',
- };
- }
- elsif (/^-?will$/i) {
- ## Make sure a callback is defined.
- return $self->error("usage: an option callback must already ",
- "be defined when enabling with $_")
- unless $s->{opt_cback};
-
- $option = &_verify_telopt_arg($self, $arg, $_);
- return unless defined $option;
- push @opt_args, { option => $option,
- is_remote => 1,
- is_enable => 1,
- };
- }
- elsif (/^-?wont$/i) {
- $option = &_verify_telopt_arg($self, $arg, $_);
- return unless defined $option;
- push @opt_args, { option => $option,
- is_remote => 1,
- is_enable => '',
- };
- }
- else {
- return $self->error('usage: $obj->option_accept(' .
- '[Do => $telopt,] ',
- '[Dont => $telopt,] ',
- '[Will => $telopt,] ',
- '[Wont => $telopt,]');
- }
- }
-
- ## Set "receive ok" for options specified.
- &_opt_accept($self, @opt_args);
-} # end sub option_accept
-
-
-sub option_callback {
- my ($self, $callback) = @_;
- my (
- $prev,
- $s,
- );
-
- $s = *$self->{net_telnet};
- $prev = $s->{opt_cback};
-
- if (@_ >= 2) {
- unless (defined $callback and ref($callback) eq "CODE") {
- &_carp($self, "ignoring Option_callback argument because it's " .
- "not a code ref");
- $callback = $prev;
- }
-
- $s->{opt_cback} = $callback;
- }
-
- $prev;
-} # end sub option_callback
-
-
-sub option_log {
- my ($self, $name) = @_;
- my (
- $fh,
- $s,
- );
-
- $s = *$self->{net_telnet};
- $fh = $s->{opt_log};
-
- if (@_ >= 2) {
- unless (defined $name) {
- $name = "";
- }
-
- $fh = &_fname_to_handle($self, $name)
- or return;
- $s->{opt_log} = $fh;
- }
-
- $fh;
-} # end sub option_log
-
-
-sub option_state {
- my ($self, $option) = @_;
- my (
- $opt_state,
- $s,
- %opt_state,
- );
-
- ## Ensure telnet option is non-negative integer.
- $option = &_verify_telopt_arg($self, $option);
- return unless defined $option;
-
- ## Init.
- $s = *$self->{net_telnet};
- unless (defined $s->{opts}{$option}) {
- &_set_default_option($s, $option);
- }
-
- ## Return hashref to a copy of the values.
- $opt_state = $s->{opts}{$option};
- %opt_state = %$opt_state;
- \%opt_state;
-} # end sub option_state
-
-
-## Make ors() synonymous with output_record_separator().
-*ors = \&output_record_separator;
-
-
-sub output_field_separator {
- my ($self, $ofs) = @_;
- my (
- $prev,
- $s,
- );
-
- $s = *$self->{net_telnet};
- $prev = $s->{ofs};
-
- if (@_ >= 2) {
- unless (defined $ofs) {
- $ofs = "";
- }
-
- $s->{ofs} = $ofs;
- }
-
- $prev;
-} # end sub output_field_separator
-
-
-sub output_log {
- my ($self, $name) = @_;
- my (
- $fh,
- $s,
- );
-
- $s = *$self->{net_telnet};
- $fh = $s->{outputlog};
-
- if (@_ >= 2) {
- unless (defined $name) {
- $name = "";
- }
-
- $fh = &_fname_to_handle($self, $name)
- or return;
- $s->{outputlog} = $fh;
- }
-
- $fh;
-} # end sub output_log
-
-
-sub output_record_separator {
- my ($self, $ors) = @_;
- my (
- $prev,
- $s,
- );
-
- $s = *$self->{net_telnet};
- $prev = $s->{ors};
-
- if (@_ >= 2) {
- unless (defined $ors) {
- $ors = "";
- }
-
- $s->{ors} = $ors;
- }
-
- $prev;
-} # end sub output_record_separator
-
-
-sub port {
- my ($self, $port) = @_;
- my (
- $prev,
- $s,
- $service,
- );
-
- $s = *$self->{net_telnet};
- $prev = $s->{port};
-
- if (@_ >= 2) {
- unless (defined $port) {
- $port = "";
- }
-
- if (!$port) {
- &_carp($self, "ignoring bad Port argument \"$port\"");
- $port = $prev;
- }
- elsif ($port !~ /^\d+$/) { # port isn't all digits
- $service = $port;
- $port = getservbyname($service, "tcp");
- unless ($port) {
- &_carp($self, "ignoring bad Port argument \"$service\": " .
- "it's an unknown TCP service");
- $port = $prev;
- }
- }
-
- $s->{port} = $port;
- }
-
- $prev;
-} # end sub port
-
-
-sub print {
- my ($self) = shift;
- my (
- $buf,
- $fh,
- $s,
- );
-
- $s = *$self->{net_telnet};
- $s->{timedout} = '';
- return $self->error("write error: filehandle isn't open")
- unless $s->{opened};
-
- ## Add field and record separators.
- $buf = join($s->{ofs}, @_) . $s->{ors};
-
- ## Log the output if requested.
- if ($s->{outputlog}) {
- &_log_print($s->{outputlog}, $buf);
- }
-
- ## Convert native newlines to CR LF.
- if (!$s->{bin_mode}) {
- $buf =~ s(\n)(\015\012)g;
- }
-
- ## Escape TELNET IAC and also CR not followed by LF.
- if ($s->{telnet_mode}) {
- $buf =~ s(\377)(\377\377)g;
- &_escape_cr(\$buf);
- }
-
- &_put($self, \$buf, "print");
-} # end sub print
-
-
-sub print_length {
- my ($self) = @_;
-
- *$self->{net_telnet}{num_wrote};
-} # end sub print_length
-
-
-sub prompt {
- my ($self, $prompt) = @_;
- my (
- $prev,
- $s,
- );
-
- $s = *$self->{net_telnet};
- $prev = $s->{cmd_prompt};
-
- ## Parse args.
- if (@_ == 2) {
- $s->{cmd_prompt} = &_parse_prompt($self, $prompt);
- }
-
- $prev;
-} # end sub prompt
-
-
-sub put {
- my ($self) = @_;
- my (
- $binmode,
- $buf,
- $errmode,
- $is_timeout_arg,
- $s,
- $telnetmode,
- $timeout,
- %args,
- );
- local $_;
-
- ## Init.
- $s = *$self->{net_telnet};
- $s->{timedout} = '';
-
- ## Parse args.
- if (@_ == 2) { # one positional arg given
- $buf = $_[1];
- }
- elsif (@_ > 2) { # named args given
- ## Get the named args.
- (undef, %args) = @_;
-
- ## Parse the named args.
- foreach (keys %args) {
- if (/^-?binmode$/i) {
- $binmode = $args{$_};
- unless (defined $binmode) {
- $binmode = 0;
- }
- }
- elsif (/^-?errmode$/i) {
- $errmode = &_parse_errmode($self, $args{$_});
- }
- elsif (/^-?string$/i) {
- $buf = $args{$_};
- }
- elsif (/^-?telnetmode$/i) {
- $telnetmode = $args{$_};
- unless (defined $telnetmode) {
- $telnetmode = 0;
- }
- }
- elsif (/^-?timeout$/i) {
- $timeout = &_parse_timeout($self, $args{$_});
- $is_timeout_arg = 1;
- }
- else {
- &_croak($self, "bad named parameter \"$_\" given ",
- "to " . ref($self) . "::put()");
- }
- }
- }
-
- ## If any args given, override corresponding instance data.
- local $s->{bin_mode} = $binmode
- if defined $binmode;
- local $s->{errormode} = $errmode
- if defined $errmode;
- local $s->{telnet_mode} = $telnetmode
- if defined $telnetmode;
- local $s->{time_out} = $timeout
- if defined $is_timeout_arg;
-
- ## Check for errors.
- return $self->error("write error: filehandle isn't open")
- unless $s->{opened};
-
- ## Log the output if requested.
- if ($s->{outputlog}) {
- &_log_print($s->{outputlog}, $buf);
- }
-
- ## Convert native newlines to CR LF.
- if (!$s->{bin_mode}) {
- $buf =~ s(\n)(\015\012)g;
- }
-
- ## Escape TELNET IAC and also CR not followed by LF.
- if ($s->{telnet_mode}) {
- $buf =~ s(\377)(\377\377)g;
- &_escape_cr(\$buf);
- }
-
- &_put($self, \$buf, "print");
-} # end sub put
-
-
-## Make rs() synonymous input_record_separator().
-*rs = \&input_record_separator;
-
-
-sub suboption_callback {
- my ($self, $callback) = @_;
- my (
- $prev,
- $s,
- );
-
- $s = *$self->{net_telnet};
- $prev = $s->{subopt_cback};
-
- if (@_ >= 2) {
- unless (defined $callback and ref($callback) eq "CODE") {
- &_carp($self,"ignoring Suboption_callback argument because it's " .
- "not a code ref");
- $callback = $prev;
- }
-
- $s->{subopt_cback} = $callback;
- }
-
- $prev;
-} # end sub suboption_callback
-
-
-sub telnetmode {
- my ($self, $mode) = @_;
- my (
- $prev,
- $s,
- );
-
- $s = *$self->{net_telnet};
- $prev = $s->{telnet_mode};
-
- if (@_ >= 2) {
- unless (defined $mode) {
- $mode = 0;
- }
-
- $s->{telnet_mode} = $mode;
- }
-
- $prev;
-} # end sub telnetmode
-
-
-sub timed_out {
- my ($self, $value) = @_;
- my (
- $prev,
- $s,
- );
-
- $s = *$self->{net_telnet};
- $prev = $s->{timedout};
-
- if (@_ >= 2) {
- unless (defined $value) {
- $value = "";
- }
-
- $s->{timedout} = $value;
- }
-
- $prev;
-} # end sub timed_out
-
-
-sub timeout {
- my ($self, $timeout) = @_;
- my (
- $prev,
- $s,
- );
-
- $s = *$self->{net_telnet};
- $prev = $s->{time_out};
-
- if (@_ >= 2) {
- $s->{time_out} = &_parse_timeout($self, $timeout);
- }
-
- $prev;
-} # end sub timeout
-
-
-sub waitfor {
- my ($self, @args) = @_;
- my (
- $arg,
- $binmode,
- $endtime,
- $errmode,
- $len,
- $match,
- $match_op,
- $pos,
- $prematch,
- $s,
- $search,
- $search_cond,
- $telnetmode,
- $timeout,
- @match_cond,
- @match_ops,
- @search_cond,
- @string_cond,
- @warns,
- );
- local $_;
-
- ## Init.
- $s = *$self->{net_telnet};
- $s->{timedout} = '';
- return if $s->{eofile};
- return unless @args;
- $timeout = $s->{time_out};
-
- ## Code template used to build string match conditional.
- ## Values between array elements must be supplied later.
- @string_cond =
- ('if (($pos = index $s->{buf}, ', ') > -1) {
- $len = ', ';
- $prematch = substr $s->{buf}, 0, $pos;
- $match = substr $s->{buf}, $pos, $len;
- substr($s->{buf}, 0, $pos + $len) = "";
- last;
- }');
-
- ## Code template used to build pattern match conditional.
- ## Values between array elements must be supplied later.
- @match_cond =
- ('if ($s->{buf} =~ ', ') {
- $prematch = $`;
- $match = $&;
- substr($s->{buf}, 0, length($`) + length($&)) = "";
- last;
- }');
-
- ## Parse args.
- if (@_ == 2) { # one positional arg given
- $arg = $_[1];
-
- ## Fill in the blanks in the code template.
- push @match_ops, $arg;
- push @search_cond, join("", $match_cond[0], $arg, $match_cond[1]);
- }
- elsif (@_ > 2) { # named args given
- ## Parse the named args.
- while (($_, $arg) = splice @args, 0, 2) {
- if (/^-?binmode$/i) {
- $binmode = $arg;
- unless (defined $binmode) {
- $binmode = 0;
- }
- }
- elsif (/^-?errmode$/i) {
- $errmode = &_parse_errmode($self, $arg);
- }
- elsif (/^-?match$/i) {
- ## Fill in the blanks in the code template.
- push @match_ops, $arg;
- push @search_cond, join("",
- $match_cond[0], $arg, $match_cond[1]);
- }
- elsif (/^-?string$/i) {
- ## Fill in the blanks in the code template.
- $arg =~ s/'/\\'/g; # quote ticks
- push @search_cond, join("",
- $string_cond[0], "'$arg'",
- $string_cond[1], length($arg),
- $string_cond[2]);
- }
- elsif (/^-?telnetmode$/i) {
- $telnetmode = $arg;
- unless (defined $telnetmode) {
- $telnetmode = 0;
- }
- }
- elsif (/^-?timeout$/i) {
- $timeout = &_parse_timeout($self, $arg);
- }
- else {
- &_croak($self, "bad named parameter \"$_\" given " .
- "to " . ref($self) . "::waitfor()");
- }
- }
- }
-
- ## If any args given, override corresponding instance data.
- local $s->{errormode} = $errmode
- if defined $errmode;
- local $s->{bin_mode} = $binmode
- if defined $binmode;
- local $s->{telnet_mode} = $telnetmode
- if defined $telnetmode;
-
- ## Check for bad match operator argument.
- foreach $match_op (@match_ops) {
- return $self->error("missing opening delimiter of match operator ",
- "in argument \"$match_op\" given to ",
- ref($self) . "::waitfor()")
- unless $match_op =~ m(^\s*/) or $match_op =~ m(^\s*m\s*\W);
- }
-
- ## Construct conditional to check for requested string and pattern matches.
- ## Turn subsequent "if"s into "elsif".
- $search_cond = join "\n\tels", @search_cond;
-
- ## Construct loop to fill buffer until string/pattern, timeout, or eof.
- $search = join "", "
- while (1) {\n\t",
- $search_cond, '
- &_fillbuf($self, $s, $endtime)
- or do {
- last if $s->{timedout};
- $self->close;
- last;
- };
- }';
-
- ## Set wall time when we timeout.
- $endtime = &_endtime($timeout);
-
- ## Run the loop.
- {
- local $^W = 1;
- local $SIG{"__WARN__"} = sub { push @warns, @_ };
- local $s->{errormode} = "return";
- $s->{errormsg} = "";
- eval $search;
- }
-
- ## Check for failure.
- return $self->error("pattern match timed-out") if $s->{timedout};
- return $self->error($s->{errormsg}) if $s->{errormsg} ne "";
- return $self->error("pattern match read eof") if $s->{eofile};
-
- ## Check for Perl syntax errors or warnings.
- if ($@ or @warns) {
- foreach $match_op (@match_ops) {
- &_match_check($self, $match_op)
- or return;
- }
- return $self->error($@) if $@;
- return $self->error(@warns) if @warns;
- }
-
- wantarray ? ($prematch, $match) : 1;
-} # end sub waitfor
-
-
-######################## Private Subroutines #########################
-
-
-sub _append_lineno {
- my ($obj, @msgs) = @_;
- my (
- $file,
- $line,
- $pkg,
- );
-
- ## Find the caller that's not in object's class or one of its base classes.
- ($pkg, $file , $line) = &_user_caller($obj);
- join("", @msgs, " at ", $file, " line ", $line, "\n");
-} # end sub _append_lineno
-
-
-sub _carp {
- warn &_append_lineno(@_);
-} # end sub _carp
-
-
-sub _croak {
- die &_append_lineno(@_);
-} # end sub _croak
-
-
-sub _endtime {
- my ($interval) = @_;
-
- ## Compute wall time when timeout occurs.
- if (defined $interval) {
- if ($interval >= $^T) { # it's already an absolute time
- return $interval;
- }
- elsif ($interval > 0) { # it's relative to the current time
- return int(time + 1.5 + $interval);
- }
- else { # it's a one time poll
- return 0;
- }
- }
- else { # there's no timeout
- return undef;
- }
-} # end sub _endtime
-
-
-sub _escape_cr {
- my ($string) = @_;
- my (
- $nextchar,
- );
- my $pos = 0;
-
- ## Convert all CR (not followed by LF) to CR NULL.
- while (($pos = index($$string, "\015", $pos)) > -1) {
- $nextchar = substr $$string, $pos + 1, 1;
-
- substr($$string, $pos, 1) = "\015\000"
- unless $nextchar eq "\012";
-
- $pos++;
- }
-
- 1;
-} # end sub _escape_cr
-
-
-sub _fillbuf {
- my ($self, $s, $endtime) = @_;
- my (
- $msg,
- $nfound,
- $nread,
- $pushback_len,
- $read_pos,
- $ready,
- $timed_out,
- $timeout,
- $unparsed_pos,
- );
-
- ## If error from last read not yet reported then do it now.
- if ($s->{pending_errormsg}) {
- $msg = $s->{pending_errormsg};
- $s->{pending_errormsg} = "";
- return $self->error($msg);
- }
-
- return unless $s->{opened};
-
- while (1) {
- ## Maximum buffer size exceeded?
- return $self->error("maximum input buffer length exceeded: ",
- $s->{maxbufsize}, " bytes")
- unless length($s->{buf}) <= $s->{maxbufsize};
-
- ## Determine how long to wait for input ready.
- ($timed_out, $timeout) = &_timeout_interval($endtime);
- if ($timed_out) {
- $s->{timedout} = 1;
- return $self->error("read timed-out");
- }
-
- ## Wait for input ready.
- $nfound = select $ready=$s->{fdmask}, "", "", $timeout;
-
- ## Handle any errors while waiting.
- if (!defined $nfound or $nfound <= 0) { # input not ready
- if (defined $nfound and $nfound == 0) { # timed-out
- $s->{timedout} = 1;
- return $self->error("read timed-out");
- }
- else { # error waiting for input ready
- next if $! =~ /^interrupted/i;
-
- $s->{opened} = '';
- return $self->error("read error: $!");
- }
- }
-
- ## Append to buffer any partially processed telnet or CR sequence.
- $pushback_len = length $s->{pushback_buf};
- if ($pushback_len) {
- $s->{buf} .= $s->{pushback_buf};
- $s->{pushback_buf} = "";
- }
-
- ## Read the waiting data.
- $read_pos = length $s->{buf};
- $unparsed_pos = $read_pos - $pushback_len;
- $nread = sysread $self, $s->{buf}, $s->{blksize}, $read_pos;
-
- ## Handle any read errors.
- if (!defined $nread) { # read failed
- next if $! =~ /^interrupted/i; # restart interrupted syscall
-
- $s->{opened} = '';
- return $self->error("read error: $!");
- }
-
- ## Handle eof.
- if ($nread == 0) { # eof read
- $s->{opened} = '';
- return;
- }
-
- ## Display network traffic if requested.
- if ($s->{dumplog}) {
- &_log_dump('<', $s->{dumplog}, \$s->{buf}, $read_pos);
- }
-
- ## Process any telnet commands in the data stream.
- if ($s->{telnet_mode} and index($s->{buf},"\377",$unparsed_pos) > -1) {
- &_interpret_tcmd($self, $s, $unparsed_pos);
- }
-
- ## Process any carriage-return sequences in the data stream.
- &_interpret_cr($s, $unparsed_pos);
-
- ## Read again if all chars read were consumed as telnet cmds.
- next if $unparsed_pos >= length $s->{buf};
-
- ## Log the input if requested.
- if ($s->{inputlog}) {
- &_log_print($s->{inputlog}, substr($s->{buf}, $unparsed_pos));
- }
-
- ## Save the last line read.
- &_save_lastline($s);
-
- ## We've successfully read some data into the buffer.
- last;
- } # end while(1)
-
- 1;
-} # end sub _fillbuf
-
-
-sub _flush_opts {
- my ($self) = @_;
- my (
- $option_chars,
- );
- my $s = *$self->{net_telnet};
-
- ## Get option and clear the output buf.
- $option_chars = $s->{unsent_opts};
- $s->{unsent_opts} = "";
-
- ## Try to send options without waiting.
- {
- local $s->{errormode} = "return";
- local $s->{time_out} = 0;
- &_put($self, \$option_chars, "telnet option negotiation")
- or do {
- ## Save chars not printed for later.
- substr($option_chars, 0, $self->print_length) = "";
- $s->{unsent_opts} .= $option_chars;
- };
- }
-
- 1;
-} # end sub _flush_opts
-
-
-sub _fname_to_handle {
- my ($self, $fh) = @_;
- my (
- $filename,
- );
-
- ## Ensure valid input.
- return ""
- unless defined $fh and (ref $fh or length $fh);
-
- ## Open a new filehandle if input is a filename.
- no strict "refs";
- if (!ref($fh) and !defined(fileno $fh)) { # fh is a filename
- $filename = $fh;
- $fh = &_new_handle();
- CORE::open $fh, "> $filename"
- or return $self->error("problem creating $filename: $!");
- }
-
- select((select($fh), $|=1)[$[]); # don't buffer writes
- $fh;
-} # end sub _fname_to_handle
-
-
-sub _have_alarm {
- eval {
- local $SIG{"__DIE__"} = "DEFAULT";
- local $SIG{ALRM} = sub { die };
- alarm 0;
- };
-
- ! $@;
-} # end sub _have_alarm
-
-
-sub _interpret_cr {
- my ($s, $pos) = @_;
- my (
- $nextchar,
- );
-
- while (($pos = index($s->{buf}, "\015", $pos)) > -1) {
- $nextchar = substr($s->{buf}, $pos + 1, 1);
- if ($nextchar eq "\0") {
- ## Convert CR NULL to CR when in telnet mode.
- if ($s->{telnet_mode}) {
- substr($s->{buf}, $pos + 1, 1) = "";
- }
- }
- elsif ($nextchar eq "\012") {
- ## Convert CR LF to newline when not in binary mode.
- if (!$s->{bin_mode}) {
- substr($s->{buf}, $pos, 2) = "\n";
- }
- }
- elsif (!length($nextchar) and ($s->{telnet_mode} or !$s->{bin_mode})) {
- ## Save CR in alt buffer for possible CR LF or CR NULL conversion.
- $s->{pushback_buf} .= "\015";
- chop $s->{buf};
- }
-
- $pos++;
- }
-
- 1;
-} # end sub _interpret_cr
-
-
-sub _interpret_tcmd {
- my ($self, $s, $offset) = @_;
- my (
- $callback,
- $endpos,
- $nextchar,
- $option,
- $parameters,
- $pos,
- $subcmd,
- );
- local $_;
-
- ## Parse telnet commands in the data stream.
- $pos = $offset;
- while (($pos = index $s->{buf}, "\377", $pos) > -1) { # unprocessed IAC
- $nextchar = substr $s->{buf}, $pos + 1, 1;
-
- ## Save command if it's only partially read.
- if (!length $nextchar) {
- $s->{pushback_buf} .= "\377";
- chop $s->{buf};
- last;
- }
-
- if ($nextchar eq "\377") { # IAC is escaping "\377" char
- ## Remove escape char from data stream.
- substr($s->{buf}, $pos, 1) = "";
- $pos++;
- }
- elsif ($nextchar eq "\375" or $nextchar eq "\373" or
- $nextchar eq "\374" or $nextchar eq "\376") { # opt negotiation
- $option = substr $s->{buf}, $pos + 2, 1;
-
- ## Save command if it's only partially read.
- if (!length $option) {
- $s->{pushback_buf} .= "\377" . $nextchar;
- chop $s->{buf};
- chop $s->{buf};
- last;
- }
-
- ## Remove command from data stream.
- substr($s->{buf}, $pos, 3) = "";
-
- ## Handle option negotiation.
- &_negotiate_recv($self, $s, $nextchar, ord($option), $pos);
- }
- elsif ($nextchar eq "\372") { # start of subnegotiation parameters
- ## Save command if it's only partially read.
- $endpos = index $s->{buf}, "\360", $pos;
- if ($endpos == -1) {
- $s->{pushback_buf} .= substr $s->{buf}, $pos;
- substr($s->{buf}, $pos) = "";
- last;
- }
-
- ## Remove subnegotiation cmd from buffer.
- $subcmd = substr($s->{buf}, $pos, $endpos - $pos + 1);
- substr($s->{buf}, $pos, $endpos - $pos + 1) = "";
-
- ## Invoke subnegotiation callback.
- if ($s->{subopt_cback} and length($subcmd) >= 5) {
- $option = unpack "C", substr($subcmd, 2, 1);
- if (length($subcmd) >= 6) {
- $parameters = substr $subcmd, 3, length($subcmd) - 5;
- }
- else {
- $parameters = "";
- }
-
- $callback = $s->{subopt_cback};
- &$callback($self, $option, $parameters);
- }
- }
- else { # various two char telnet commands
- ## Ignore and remove command from data stream.
- substr($s->{buf}, $pos, 2) = "";
- }
- }
-
- ## Try to send any waiting option negotiation.
- if (length $s->{unsent_opts}) {
- &_flush_opts($self);
- }
-
- 1;
-} # end sub _interpret_tcmd
-
-
-sub _io_socket_include {
- local $SIG{"__DIE__"} = "DEFAULT";
- eval "require IO::Socket";
-} # end sub io_socket_include
-
-
-sub _log_dump {
- my ($direction, $fh, $data, $offset, $len) = @_;
- my (
- $addr,
- $hexvals,
- $line,
- );
-
- $addr = 0;
- $len = length($$data) - $offset
- if !defined $len;
- return 1 if $len <= 0;
-
- ## Print data in dump format.
- while ($len > 0) {
- ## Convert up to the next 16 chars to hex, padding w/ spaces.
- if ($len >= 16) {
- $line = substr $$data, $offset, 16;
- }
- else {
- $line = substr $$data, $offset, $len;
- }
- $hexvals = unpack("H*", $line);
- $hexvals .= ' ' x (32 - length $hexvals);
-
- ## Place in 16 columns, each containing two hex digits.
- $hexvals = sprintf("%s %s %s %s " x 4,
- unpack("a2" x 16, $hexvals));
-
- ## For the ASCII column, change unprintable chars to a period.
- $line =~ s/[\000-\037,\177-\237]/./g;
-
- ## Print the line in dump format.
- &_log_print($fh, sprintf("%s 0x%5.5lx: %s%s\n",
- $direction, $addr, $hexvals, $line));
-
- $addr += 16;
- $offset += 16;
- $len -= 16;
- }
-
- &_log_print($fh, "\n");
-
- 1;
-} # end sub _log_dump
-
-
-sub _log_option {
- my ($fh, $direction, $request, $option) = @_;
- my (
- $name,
- );
-
- if ($option >= 0 and $option <= $#Telopts) {
- $name = $Telopts[$option];
- }
- else {
- $name = $option;
- }
-
- &_log_print($fh, "$direction $request $name\n");
-} # end sub _log_option
-
-
-sub _log_print {
- my ($fh, $buf) = @_;
- local $\ = '';
-
- if (ref($fh) and ref($fh) ne "GLOB") { # fh is blessed ref
- $fh->print($buf);
- }
- else { # fh isn't blessed ref
- print $fh $buf;
- }
-} # end sub _log_print
-
-
-sub _match_check {
- my ($self, $code) = @_;
- my $error;
- my @warns = ();
-
- ## Use eval to check for syntax errors or warnings.
- {
- local $SIG{"__DIE__"} = "DEFAULT";
- local $SIG{"__WARN__"} = sub { push @warns, @_ };
- local $^W = 1;
- local $_ = '';
- eval "\$_ =~ $code;";
- }
- if ($@) {
- ## Remove useless lines numbers from message.
- ($error = $@) =~ s/ at \(eval \d+\) line \d+.?//;
- chomp $error;
- return $self->error("bad match operator: $error");
- }
- elsif (@warns) {
- ## Remove useless lines numbers from message.
- ($error = shift @warns) =~ s/ at \(eval \d+\) line \d+.?//;
- $error =~ s/ while "strict subs" in use//;
- chomp $error;
- return $self->error("bad match operator: $error");
- }
-
- 1;
-} # end sub _match_check
-
-
-sub _negotiate_callback {
- my ($self, $opt, $is_remote, $is_enabled, $was_enabled, $opt_bufpos) = @_;
- my (
- $callback,
- $s,
- );
- local $_;
-
- ## Keep track of remote echo.
- if ($is_remote and $opt == &TELOPT_ECHO) { # received WILL or WONT ECHO
- $s = *$self->{net_telnet};
-
- if ($is_enabled and !$was_enabled) { # received WILL ECHO
- $s->{remote_echo} = 1;
- }
- elsif (!$is_enabled and $was_enabled) { # received WONT ECHO
- $s->{remote_echo} = '';
- }
- }
-
- ## Invoke callback, if there is one.
- $callback = $self->option_callback;
- if ($callback) {
- &$callback($self, $opt, $is_remote,
- $is_enabled, $was_enabled, $opt_bufpos);
- }
-
- 1;
-} # end sub _negotiate_callback
-
-
-sub _negotiate_recv {
- my ($self, $s, $opt_request, $opt, $opt_bufpos) = @_;
-
- ## Ensure data structure exists for this option.
- unless (defined $s->{opts}{$opt}) {
- &_set_default_option($s, $opt);
- }
-
- ## Process the option.
- if ($opt_request eq "\376") { # DONT
- &_negotiate_recv_disable($self, $s, $opt, "dont", $opt_bufpos,
- $s->{opts}{$opt}{local_enable_ok},
- \$s->{opts}{$opt}{local_enabled},
- \$s->{opts}{$opt}{local_state});
- }
- elsif ($opt_request eq "\375") { # DO
- &_negotiate_recv_enable($self, $s, $opt, "do", $opt_bufpos,
- $s->{opts}{$opt}{local_enable_ok},
- \$s->{opts}{$opt}{local_enabled},
- \$s->{opts}{$opt}{local_state});
- }
- elsif ($opt_request eq "\374") { # WONT
- &_negotiate_recv_disable($self, $s, $opt, "wont", $opt_bufpos,
- $s->{opts}{$opt}{remote_enable_ok},
- \$s->{opts}{$opt}{remote_enabled},
- \$s->{opts}{$opt}{remote_state});
- }
- elsif ($opt_request eq "\373") { # WILL
- &_negotiate_recv_enable($self, $s, $opt, "will", $opt_bufpos,
- $s->{opts}{$opt}{remote_enable_ok},
- \$s->{opts}{$opt}{remote_enabled},
- \$s->{opts}{$opt}{remote_state});
- }
- else { # internal error
- die;
- }
-
- 1;
-} # end sub _negotiate_recv
-
-
-sub _negotiate_recv_disable {
- my ($self, $s, $opt, $opt_request,
- $opt_bufpos, $enable_ok, $is_enabled, $state) = @_;
- my (
- $ack,
- $disable_cmd,
- $enable_cmd,
- $is_remote,
- $nak,
- $was_enabled,
- );
-
- ## What do we use to request enable/disable or respond with ack/nak.
- if ($opt_request eq "wont") {
- $enable_cmd = "\377\375" . pack("C", $opt); # do command
- $disable_cmd = "\377\376" . pack("C", $opt); # dont command
- $is_remote = 1;
- $ack = "DO";
- $nak = "DONT";
-
- &_log_option($s->{opt_log}, "RCVD", "WONT", $opt)
- if $s->{opt_log};
- }
- elsif ($opt_request eq "dont") {
- $enable_cmd = "\377\373" . pack("C", $opt); # will command
- $disable_cmd = "\377\374" . pack("C", $opt); # wont command
- $is_remote = '';
- $ack = "WILL";
- $nak = "WONT";
-
- &_log_option($s->{opt_log}, "RCVD", "DONT", $opt)
- if $s->{opt_log};
- }
- else { # internal error
- die;
- }
-
- ## Respond to WONT or DONT based on the current negotiation state.
- if ($$state eq "no") { # state is already disabled
- }
- elsif ($$state eq "yes") { # they're initiating disable
- $$is_enabled = '';
- $$state = "no";
-
- ## Send positive acknowledgment.
- $s->{unsent_opts} .= $disable_cmd;
- &_log_option($s->{opt_log}, "SENT", $nak, $opt)
- if $s->{opt_log};
-
- ## Invoke callbacks.
- &_negotiate_callback($self, $opt, $is_remote,
- $$is_enabled, $was_enabled, $opt_bufpos);
- }
- elsif ($$state eq "wantno") { # they sent positive ack
- $$is_enabled = '';
- $$state = "no";
-
- ## Invoke callback.
- &_negotiate_callback($self, $opt, $is_remote,
- $$is_enabled, $was_enabled, $opt_bufpos);
- }
- elsif ($$state eq "wantno opposite") { # pos ack but we changed our mind
- ## Indicate disabled but now we want to enable.
- $$is_enabled = '';
- $$state = "wantyes";
-
- ## Send queued request.
- $s->{unsent_opts} .= $enable_cmd;
- &_log_option($s->{opt_log}, "SENT", $ack, $opt)
- if $s->{opt_log};
-
- ## Invoke callback.
- &_negotiate_callback($self, $opt, $is_remote,
- $$is_enabled, $was_enabled, $opt_bufpos);
- }
- elsif ($$state eq "wantyes") { # they sent negative ack
- $$is_enabled = '';
- $$state = "no";
-
- ## Invoke callback.
- &_negotiate_callback($self, $opt, $is_remote,
- $$is_enabled, $was_enabled, $opt_bufpos);
- }
- elsif ($$state eq "wantyes opposite") { # nak but we changed our mind
- $$is_enabled = '';
- $$state = "no";
-
- ## Invoke callback.
- &_negotiate_callback($self, $opt, $is_remote,
- $$is_enabled, $was_enabled, $opt_bufpos);
- }
-} # end sub _negotiate_recv_disable
-
-
-sub _negotiate_recv_enable {
- my ($self, $s, $opt, $opt_request,
- $opt_bufpos, $enable_ok, $is_enabled, $state) = @_;
- my (
- $ack,
- $disable_cmd,
- $enable_cmd,
- $is_remote,
- $nak,
- $was_enabled,
- );
-
- ## What we use to send enable/disable request or send ack/nak response.
- if ($opt_request eq "will") {
- $enable_cmd = "\377\375" . pack("C", $opt); # do command
- $disable_cmd = "\377\376" . pack("C", $opt); # dont command
- $is_remote = 1;
- $ack = "DO";
- $nak = "DONT";
-
- &_log_option($s->{opt_log}, "RCVD", "WILL", $opt)
- if $s->{opt_log};
- }
- elsif ($opt_request eq "do") {
- $enable_cmd = "\377\373" . pack("C", $opt); # will command
- $disable_cmd = "\377\374" . pack("C", $opt); # wont command
- $is_remote = '';
- $ack = "WILL";
- $nak = "WONT";
-
- &_log_option($s->{opt_log}, "RCVD", "DO", $opt)
- if $s->{opt_log};
- }
- else { # internal error
- die;
- }
-
- ## Save current enabled state.
- $was_enabled = $$is_enabled;
-
- ## Respond to WILL or DO based on the current negotiation state.
- if ($$state eq "no") { # they're initiating enable
- if ($enable_ok) { # we agree they/us should enable
- $$is_enabled = 1;
- $$state = "yes";
-
- ## Send positive acknowledgment.
- $s->{unsent_opts} .= $enable_cmd;
- &_log_option($s->{opt_log}, "SENT", $ack, $opt)
- if $s->{opt_log};
-
- ## Invoke callbacks.
- &_negotiate_callback($self, $opt, $is_remote,
- $$is_enabled, $was_enabled, $opt_bufpos);
- }
- else { # we disagree they/us should enable
- ## Send negative acknowledgment.
- $s->{unsent_opts} .= $disable_cmd;
- &_log_option($s->{opt_log}, "SENT", $nak, $opt)
- if $s->{opt_log};
- }
- }
- elsif ($$state eq "yes") { # state is already enabled
- }
- elsif ($$state eq "wantno") { # error: our disable req answered by enable
- $$is_enabled = '';
- $$state = "no";
-
- ## Invoke callbacks.
- &_negotiate_callback($self, $opt, $is_remote,
- $$is_enabled, $was_enabled, $opt_bufpos);
- }
- elsif ($$state eq "wantno opposite") { # err: disable req answerd by enable
- $$is_enabled = 1;
- $$state = "yes";
-
- ## Invoke callbacks.
- &_negotiate_callback($self, $opt, $is_remote,
- $$is_enabled, $was_enabled, $opt_bufpos);
- }
- elsif ($$state eq "wantyes") { # they sent pos ack
- $$is_enabled = 1;
- $$state = "yes";
-
- ## Invoke callback.
- &_negotiate_callback($self, $opt, $is_remote,
- $$is_enabled, $was_enabled, $opt_bufpos);
- }
- elsif ($$state eq "wantyes opposite") { # pos ack but we changed our mind
- ## Indicate enabled but now we want to disable.
- $$is_enabled = 1;
- $$state = "wantno";
-
- ## Inform other side we changed our mind.
- $s->{unsent_opts} .= $disable_cmd;
- &_log_option($s->{opt_log}, "SENT", $nak, $opt)
- if $s->{opt_log};
-
- ## Invoke callback.
- &_negotiate_callback($self, $opt, $is_remote,
- $$is_enabled, $was_enabled, $opt_bufpos);
- }
-
- 1;
-} # end sub _negotiate_recv_enable
-
-
-sub _new_handle {
- if ($INC{"IO/Handle.pm"}) {
- return IO::Handle->new;
- }
- else {
- require FileHandle;
- return FileHandle->new;
- }
-} # end sub _new_handle
-
-
-sub _next_getlines {
- my ($self, $s) = @_;
- my (
- $len,
- $line,
- $pos,
- @lines,
- );
-
- ## Fill buffer and get first line.
- $line = $self->getline
- or return;
- push @lines, $line;
-
- ## Extract subsequent lines from buffer.
- while (($pos = index($s->{buf}, $s->{rs})) != -1) {
- $len = $pos + length $s->{rs};
- push @lines, substr($s->{buf}, 0, $len);
- substr($s->{buf}, 0, $len) = "";
- }
-
- @lines;
-} # end sub _next_getlines
-
-
-sub _opt_accept {
- my ($self, @args) = @_;
- my (
- $arg,
- $option,
- $s,
- );
-
- ## Init.
- $s = *$self->{net_telnet};
-
- foreach $arg (@args) {
- ## Ensure data structure defined for this option.
- $option = $arg->{option};
- if (!defined $s->{opts}{$option}) {
- &_set_default_option($s, $option);
- }
-
- ## Save whether we'll accept or reject this option.
- if ($arg->{is_remote}) {
- $s->{opts}{$option}{remote_enable_ok} = $arg->{is_enable};
- }
- else {
- $s->{opts}{$option}{local_enable_ok} = $arg->{is_enable};
- }
- }
-
- 1;
-} # end sub _opt_accept
-
-
-sub _optimal_blksize {
- my ($blksize) = @_;
- local $^W = ''; # avoid non-numeric warning for ms-windows blksize of ""
-
- ## Use default when block size is invalid.
- return 8192
- unless defined $blksize and $blksize >= 1 and $blksize <= 1_048_576;
-
- $blksize;
-} # end sub _optimal_blksize
-
-
-sub _parse_cmd_remove_mode {
- my ($self, $mode) = @_;
-
- if (!defined $mode) {
- $mode = 0;
- }
- elsif ($mode =~ /^\s*auto\s*$/i) {
- $mode = "auto";
- }
- elsif ($mode !~ /^\d+$/) {
- &_carp($self, "ignoring bad Cmd_remove_mode " .
- "argument \"$mode\": it's not \"auto\" or a " .
- "non-negative integer");
- $mode = *$self->{net_telnet}{cmd_rm_mode};
- }
-
- $mode;
-} # end sub _parse_cmd_remove_mode
-
-
-sub _parse_errmode {
- my ($self, $errmode) = @_;
-
- ## Set the error mode.
- if (!defined $errmode) {
- &_carp($self, "ignoring undefined Errmode argument");
- $errmode = *$self->{net_telnet}{errormode};
- }
- elsif ($errmode =~ /^\s*return\s*$/i) {
- $errmode = "return";
- }
- elsif ($errmode =~ /^\s*die\s*$/i) {
- $errmode = "die";
- }
- elsif (ref($errmode) eq "CODE") {
- }
- elsif (ref($errmode) eq "ARRAY") {
- unless (ref($errmode->[0]) eq "CODE") {
- &_carp($self, "ignoring bad Errmode argument: " .
- "first list item isn't a code ref");
- $errmode = *$self->{net_telnet}{errormode};
- }
- }
- else {
- &_carp($self, "ignoring bad Errmode argument \"$errmode\"");
- $errmode = *$self->{net_telnet}{errormode};
- }
-
- $errmode;
-} # end sub _parse_errmode
-
-
-sub _parse_input_record_separator {
- my ($self, $rs) = @_;
-
- unless (defined $rs and length $rs) {
- &_carp($self, "ignoring null Input_record_separator argument");
- $rs = *$self->{net_telnet}{rs};
- }
-
- $rs;
-} # end sub _parse_input_record_separator
-
-
-sub _parse_prompt {
- my ($self, $prompt) = @_;
-
- unless (defined $prompt) {
- $prompt = "";
- }
-
- unless ($prompt =~ m(^\s*/) or $prompt =~ m(^\s*m\s*\W)) {
- &_carp($self, "ignoring bad Prompt argument \"$prompt\": " .
- "missing opening delimiter of match operator");
- $prompt = *$self->{net_telnet}{cmd_prompt};
- }
-
- $prompt;
-} # end sub _parse_prompt
-
-
-sub _parse_timeout {
- my ($self, $timeout) = @_;
-
- ## Ensure valid timeout.
- if (defined $timeout) {
- ## Test for non-numeric or negative values.
- eval {
- local $SIG{"__DIE__"} = "DEFAULT";
- local $SIG{"__WARN__"} = sub { die "non-numeric\n" };
- local $^W = 1;
- $timeout *= 1;
- };
- if ($@) { # timeout arg is non-numeric
- &_carp($self,
- "ignoring non-numeric Timeout argument \"$timeout\"");
- $timeout = *$self->{net_telnet}{time_out};
- }
- elsif ($timeout < 0) { # timeout arg is negative
- &_carp($self, "ignoring negative Timeout argument \"$timeout\"");
- $timeout = *$self->{net_telnet}{time_out};
- }
- }
-
- $timeout;
-} # end sub _parse_timeout
-
-
-sub _put {
- my ($self, $buf, $subname) = @_;
- my (
- $endtime,
- $len,
- $nfound,
- $nwrote,
- $offset,
- $ready,
- $s,
- $timed_out,
- $timeout,
- $zero_wrote_count,
- );
-
- ## Init.
- $s = *$self->{net_telnet};
- $s->{num_wrote} = 0;
- $zero_wrote_count = 0;
- $offset = 0;
- $len = length $$buf;
- $endtime = &_endtime($s->{time_out});
-
- return $self->error("write error: filehandle isn't open")
- unless $s->{opened};
-
- ## Try to send any waiting option negotiation.
- if (length $s->{unsent_opts}) {
- &_flush_opts($self);
- }
-
- ## Write until all data blocks written.
- while ($len) {
- ## Determine how long to wait for output ready.
- ($timed_out, $timeout) = &_timeout_interval($endtime);
- if ($timed_out) {
- $s->{timedout} = 1;
- return $self->error("$subname timed-out");
- }
-
- ## Wait for output ready.
- $nfound = select "", $ready=$s->{fdmask}, "", $timeout;
-
- ## Handle any errors while waiting.
- if (!defined $nfound or $nfound <= 0) { # output not ready
- if (defined $nfound and $nfound == 0) { # timed-out
- $s->{timedout} = 1;
- return $self->error("$subname timed-out");
- }
- else { # error waiting for output ready
- next if $! =~ /^interrupted/i;
-
- $s->{opened} = '';
- return $self->error("write error: $!");
- }
- }
-
- ## Write the data.
- $nwrote = syswrite $self, $$buf, $len, $offset;
-
- ## Handle any write errors.
- if (!defined $nwrote) { # write failed
- next if $! =~ /^interrupted/i; # restart interrupted syscall
-
- $s->{opened} = '';
- return $self->error("write error: $!");
- }
- elsif ($nwrote == 0) { # zero chars written
- ## Try ten more times to write the data.
- if ($zero_wrote_count++ <= 10) {
- &_sleep(0.01);
- next;
- }
-
- $s->{opened} = '';
- return $self->error("write error: zero length write: $!");
- }
-
- ## Display network traffic if requested.
- if ($s->{dumplog}) {
- &_log_dump('>', $s->{dumplog}, $buf, $offset, $nwrote);
- }
-
- ## Increment.
- $s->{num_wrote} += $nwrote;
- $offset += $nwrote;
- $len -= $nwrote;
- }
-
- 1;
-} # end sub _put
-
-
-sub _qualify_fh {
- my ($obj, $name) = @_;
- my (
- $user_class,
- );
- local $_;
-
- ## Get user's package name.
- ($user_class) = &_user_caller($obj);
-
- ## Ensure name is qualified with a package name.
- $name = qualify($name, $user_class);
-
- ## If it's not already, make it a typeglob ref.
- if (!ref $name) {
- no strict;
- local $^W = 0;
-
- $name =~ s/^\*+//;
- $name = eval "\\*$name";
- return unless ref $name;
- }
-
- $name;
-} # end sub _qualify_fh
-
-
-sub _reset_options {
- my ($opts) = @_;
- my (
- $opt,
- );
-
- foreach $opt (keys %$opts) {
- $opts->{$opt}{remote_enabled} = '';
- $opts->{$opt}{remote_state} = "no";
- $opts->{$opt}{local_enabled} = '';
- $opts->{$opt}{local_state} = "no";
- }
-
- 1;
-} # end sub _reset_options
-
-
-sub _save_lastline {
- my ($s) = @_;
- my (
- $firstpos,
- $lastpos,
- $len_w_sep,
- $len_wo_sep,
- $offset,
- );
- my $rs = "\n";
-
- if (($lastpos = rindex $s->{buf}, $rs) > -1) { # eol found
- while (1) {
- ## Find beginning of line.
- $firstpos = rindex $s->{buf}, $rs, $lastpos - 1;
- if ($firstpos == -1) {
- $offset = 0;
- }
- else {
- $offset = $firstpos + length $rs;
- }
-
- ## Determine length of line with and without separator.
- $len_wo_sep = $lastpos - $offset;
- $len_w_sep = $len_wo_sep + length $rs;
-
- ## Save line if it's not blank.
- if (substr($s->{buf}, $offset, $len_wo_sep)
- !~ /^\s*$/)
- {
- $s->{last_line} = substr($s->{buf},
- $offset,
- $len_w_sep);
- last;
- }
-
- last if $firstpos == -1;
-
- $lastpos = $firstpos;
- }
- }
-
- 1;
-} # end sub _save_lastline
-
-
-sub _set_default_option {
- my ($s, $option) = @_;
-
- $s->{opts}{$option} = {
- remote_enabled => '',
- remote_state => "no",
- remote_enable_ok => '',
- local_enabled => '',
- local_state => "no",
- local_enable_ok => '',
- };
-} # end sub _set_default_option
-
-
-sub _sleep {
- my ($secs) = @_;
- my $bitmask = "";
- local *SOCK;
-
- socket SOCK, AF_INET, SOCK_STREAM, 0;
- vec($bitmask, fileno(SOCK), 1) = 1;
- select $bitmask, "", "", $secs;
- CORE::close SOCK;
-
- 1;
-} # end sub _sleep
-
-
-sub _timeout_interval {
- my ($endtime) = @_;
- my (
- $timeout,
- );
-
- ## Return timed-out boolean and timeout interval.
- if (defined $endtime) {
- ## Is it a one-time poll.
- return ('', 0) if $endtime == 0;
-
- ## Calculate the timeout interval.
- $timeout = $endtime - time;
-
- ## Did we already timeout.
- return (1, 0) unless $timeout > 0;
-
- return ('', $timeout);
- }
- else { # there is no timeout
- return ('', undef);
- }
-} # end sub _timeout_interval
-
-
-sub _user_caller {
- my ($obj) = @_;
- my (
- $class,
- $curr_pkg,
- $file,
- $i,
- $line,
- $pkg,
- %isa,
- @isa,
- );
- local $_;
-
- ## Create a boolean hash to test for isa. Make sure current
- ## package and the object's class are members.
- $class = ref $obj;
- @isa = eval "\@${class}::ISA";
- push @isa, $class;
- ($curr_pkg) = caller 1;
- push @isa, $curr_pkg;
- %isa = map { $_ => 1 } @isa;
-
- ## Search back in call frames for a package that's not in isa.
- $i = 1;
- while (($pkg, $file, $line) = caller ++$i) {
- next if $isa{$pkg};
-
- return ($pkg, $file, $line);
- }
-
- ## If not found, choose outer most call frame.
- ($pkg, $file, $line) = caller --$i;
- return ($pkg, $file, $line);
-} # end sub _user_caller
-
-
-sub _verify_telopt_arg {
- my ($self, $option, $argname) = @_;
-
- ## If provided, use argument name in error message.
- if (defined $argname) {
- $argname = "for arg $argname";
- }
- else {
- $argname = "";
- }
-
- ## Ensure telnet option is a non-negative integer.
- eval {
- local $SIG{"__DIE__"} = "DEFAULT";
- local $SIG{"__WARN__"} = sub { die "non-numeric\n" };
- local $^W = 1;
- $option = abs(int $option);
- };
- return $self->error("bad telnet option $argname: non-numeric")
- if $@;
-
- return $self->error("bad telnet option $argname: option > 255")
- unless $option <= 255;
-
- $option;
-} # end sub _verify_telopt_arg
-
-
-######################## Exported Constants ##########################
-
-
-sub TELNET_IAC () {255}; # interpret as command:
-sub TELNET_DONT () {254}; # you are not to use option
-sub TELNET_DO () {253}; # please, you use option
-sub TELNET_WONT () {252}; # I won't use option
-sub TELNET_WILL () {251}; # I will use option
-sub TELNET_SB () {250}; # interpret as subnegotiation
-sub TELNET_GA () {249}; # you may reverse the line
-sub TELNET_EL () {248}; # erase the current line
-sub TELNET_EC () {247}; # erase the current character
-sub TELNET_AYT () {246}; # are you there
-sub TELNET_AO () {245}; # abort output--but let prog finish
-sub TELNET_IP () {244}; # interrupt process--permanently
-sub TELNET_BREAK () {243}; # break
-sub TELNET_DM () {242}; # data mark--for connect. cleaning
-sub TELNET_NOP () {241}; # nop
-sub TELNET_SE () {240}; # end sub negotiation
-sub TELNET_EOR () {239}; # end of record (transparent mode)
-sub TELNET_ABORT () {238}; # Abort process
-sub TELNET_SUSP () {237}; # Suspend process
-sub TELNET_EOF () {236}; # End of file
-sub TELNET_SYNCH () {242}; # for telfunc calls
-
-sub TELOPT_BINARY () {0}; # Binary Transmission
-sub TELOPT_ECHO () {1}; # Echo
-sub TELOPT_RCP () {2}; # Reconnection
-sub TELOPT_SGA () {3}; # Suppress Go Ahead
-sub TELOPT_NAMS () {4}; # Approx Message Size Negotiation
-sub TELOPT_STATUS () {5}; # Status
-sub TELOPT_TM () {6}; # Timing Mark
-sub TELOPT_RCTE () {7}; # Remote Controlled Trans and Echo
-sub TELOPT_NAOL () {8}; # Output Line Width
-sub TELOPT_NAOP () {9}; # Output Page Size
-sub TELOPT_NAOCRD () {10}; # Output Carriage-Return Disposition
-sub TELOPT_NAOHTS () {11}; # Output Horizontal Tab Stops
-sub TELOPT_NAOHTD () {12}; # Output Horizontal Tab Disposition
-sub TELOPT_NAOFFD () {13}; # Output Formfeed Disposition
-sub TELOPT_NAOVTS () {14}; # Output Vertical Tabstops
-sub TELOPT_NAOVTD () {15}; # Output Vertical Tab Disposition
-sub TELOPT_NAOLFD () {16}; # Output Linefeed Disposition
-sub TELOPT_XASCII () {17}; # Extended ASCII
-sub TELOPT_LOGOUT () {18}; # Logout
-sub TELOPT_BM () {19}; # Byte Macro
-sub TELOPT_DET () {20}; # Data Entry Terminal
-sub TELOPT_SUPDUP () {21}; # SUPDUP
-sub TELOPT_SUPDUPOUTPUT () {22}; # SUPDUP Output
-sub TELOPT_SNDLOC () {23}; # Send Location
-sub TELOPT_TTYPE () {24}; # Terminal Type
-sub TELOPT_EOR () {25}; # End of Record
-sub TELOPT_TUID () {26}; # TACACS User Identification
-sub TELOPT_OUTMRK () {27}; # Output Marking
-sub TELOPT_TTYLOC () {28}; # Terminal Location Number
-sub TELOPT_3270REGIME () {29}; # Telnet 3270 Regime
-sub TELOPT_X3PAD () {30}; # X.3 PAD
-sub TELOPT_NAWS () {31}; # Negotiate About Window Size
-sub TELOPT_TSPEED () {32}; # Terminal Speed
-sub TELOPT_LFLOW () {33}; # Remote Flow Control
-sub TELOPT_LINEMODE () {34}; # Linemode
-sub TELOPT_XDISPLOC () {35}; # X Display Location
-sub TELOPT_OLD_ENVIRON () {36}; # Environment Option
-sub TELOPT_AUTHENTICATION () {37}; # Authentication Option
-sub TELOPT_ENCRYPT () {38}; # Encryption Option
-sub TELOPT_NEW_ENVIRON () {39}; # New Environment Option
-sub TELOPT_EXOPL () {255}; # Extended-Options-List
-
-
-1;
-__END__;
-
-
-######################## User Documentation ##########################
-
-
-## To format the following documentation into a more readable format,
-## use one of these programs: perldoc; pod2man; pod2html; pod2text.
-## For example, to nicely format this documentation for printing, you
-## may use pod2man and groff to convert to postscript:
-## pod2man Net/Telnet.pm | groff -man -Tps > Net::Telnet.ps
-
-=head1 NAME
-
-Net::Telnet - interact with TELNET port or other TCP ports
-
-=head1 SYNOPSIS
-
-C<use Net::Telnet ();>
-
-see METHODS section below
-
-=head1 DESCRIPTION
-
-Net::Telnet allows you to make client connections to a TCP port and do
-network I/O, especially to a port using the TELNET protocol. Simple
-I/O methods such as print, get, and getline are provided. More
-sophisticated interactive features are provided because connecting to
-a TELNET port ultimately means communicating with a program designed
-for human interaction. These interactive features include the ability
-to specify a time-out and to wait for patterns to appear in the input
-stream, such as the prompt from a shell.
-
-Other reasons to use this module than strictly with a TELNET port are:
-
-=over 2
-
-=item *
-
-You're not familiar with sockets and you want a simple way to make
-client connections to TCP services.
-
-=item *
-
-You want to be able to specify your own time-out while connecting,
-reading, or writing.
-
-=item *
-
-You're communicating with an interactive program at the other end of
-some socket or pipe and you want to wait for certain patterns to
-appear.
-
-=back
-
-Here's an example that prints who's logged-on to the remote host
-sparky. In addition to a username and password, you must also know
-the user's shell prompt, which for this example is C<bash$>
-
- use Net::Telnet ();
- $t = new Net::Telnet (Timeout => 10,
- Prompt => '/bash\$ $/');
- $t->open("sparky");
- $t->login($username, $passwd);
- @lines = $t->cmd("who");
- print @lines;
-
-More examples are in the B<EXAMPLES> section below.
-
-Usage questions should be directed to the Usenet newsgroup
-comp.lang.perl.modules.
-
-Contact me, Jay Rogers <jay@rgrs.com>, if you find any bugs or have
-suggestions for improvement.
-
-=head2 What To Know Before Using
-
-=over 2
-
-=item *
-
-All output is flushed while all input is buffered. Each object
-contains its own input buffer.
-
-=item *
-
-The output record separator for C<print()> and C<cmd()> is set to
-C<"\n"> by default, so that you don't have to append all your commands
-with a newline. To avoid printing a trailing C<"\n"> use C<put()> or
-set the I<output_record_separator> to C<"">.
-
-=item *
-
-The methods C<login()> and C<cmd()> use the I<prompt> setting in the
-object to determine when a login or remote command is complete. Those
-methods will fail with a time-out if you don't set the prompt
-correctly.
-
-=item *
-
-Use a combination of C<print()> and C<waitfor()> as an alternative to
-C<login()> or C<cmd()> when they don't do what you want.
-
-=item *
-
-Errors such as timing-out are handled according to the error mode
-action. The default action is to print an error message to standard
-error and have the program die. See the C<errmode()> method for more
-information.
-
-=item *
-
-When constructing the match operator argument for C<prompt()> or
-C<waitfor()>, always use single quotes instead of double quotes to
-avoid unexpected backslash interpretation (e.g. C<'/bash\$ $/'>). If
-you're constructing a DOS like file path, you'll need to use four
-backslashes to represent one (e.g. C<'/c:\\\\users\\\\billE<gt>$/i'>).
-
-Of course don't forget about regexp metacharacters like C<.>, C<[>, or
-C<$>. You'll only need a single backslash to quote them. The anchor
-metacharacters C<^> and C<$> refer to positions in the input buffer.
-To avoid matching characters read that look like a prompt, it's a good
-idea to end your prompt pattern with the C<$> anchor. That way the
-prompt will only match if it's the last thing read.
-
-=item *
-
-In the input stream, each sequence of I<carriage return> and I<line
-feed> (i.e. C<"\015\012"> or CR LF) is converted to C<"\n">. In the
-output stream, each occurrence of C<"\n"> is converted to a sequence
-of CR LF. See C<binmode()> to change the behavior. TCP protocols
-typically use the ASCII sequence, carriage return and line feed to
-designate a newline.
-
-=item *
-
-Timing-out while making a connection is disabled for machines that
-don't support the C<alarm()> function. Most notably these include
-MS-Windows machines.
-
-=item *
-
-You'll need to be running at least Perl version 5.002 to use this
-module. This module does not require any libraries that don't already
-come with a standard Perl distribution.
-
-If you have the IO:: libraries installed (they come standard with
-perl5.004 and later) then IO::Socket::INET is used as a base class,
-otherwise FileHandle is used.
-
-=item *
-
-Contact me, Jay Rogers <jay@rgrs.com>, if you find any bugs or have
-suggestions for improvement.
-
-=back
-
-=head2 Debugging
-
-The typical usage bug causes a time-out error because you've made
-incorrect assumptions about what the remote side actually sends. The
-easiest way to reconcile what the remote side sends with your
-expectations is to use C<input_log()> or C<dump_log()>.
-
-C<dump_log()> allows you to see the data being sent from the remote
-side before any translation is done, while C<input_log()> shows you
-the results after translation. The translation includes converting
-end of line characters, removing and responding to TELNET protocol
-commands in the data stream.
-
-=head2 Style of Named Parameters
-
-Two different styles of named parameters are supported. This document
-only shows the IO:: style:
-
- Net::Telnet->new(Timeout => 20);
-
-however the dash-option style is also allowed:
-
- Net::Telnet->new(-timeout => 20);
-
-=head2 Connecting to a Remote MS-Windows Machine
-
-By default MS-Windows doesn't come with a TELNET server. However
-third party TELNET servers are available. Unfortunately many of these
-servers falsely claim to be a TELNET server. This is especially true
-of the so-called "Microsoft Telnet Server" that comes installed with
-some newer versions MS-Windows.
-
-When a TELNET server first accepts a connection, it must use the ASCII
-control characters carriage-return and line-feed to start a new line
-(see RFC854). A server like the "Microsoft Telnet Server" that
-doesn't do this, isn't a TELNET server. These servers send ANSI
-terminal escape sequences to position to a column on a subsequent line
-and to even position while writing characters that are adjacent to
-each other. Worse, when sending output these servers resend
-previously sent command output in a misguided attempt to display an
-entire terminal screen.
-
-Connecting Net::Telnet to one of these false TELNET servers makes your
-job of parsing command output very difficult. It's better to replace
-a false TELNET server with a real TELNET server. The better TELNET
-servers for MS-Windows allow you to avoid the ANSI escapes by turning
-off something some of them call I<console mode>.
-
-
-=head1 METHODS
-
-In the calling sequences below, square brackets B<[]> represent
-optional parameters.
-
-=over 4
-
-=item B<new> - create a new Net::Telnet object
-
- $obj = new Net::Telnet ([$host]);
-
- $obj = new Net::Telnet ([Binmode => $mode,]
- [Cmd_remove_mode => $mode,]
- [Dump_Log => $filename,]
- [Errmode => $errmode,]
- [Fhopen => $filehandle,]
- [Host => $host,]
- [Input_log => $file,]
- [Input_record_separator => $chars,]
- [Option_log => $file,]
- [Ors => $chars,]
- [Output_log => $file,]
- [Output_record_separator => $chars,]
- [Port => $port,]
- [Prompt => $matchop,]
- [Rs => $chars,]
- [Telnetmode => $mode,]
- [Timeout => $secs,]);
-
-This is the constructor for Net::Telnet objects. A new object is
-returned on success, the error mode action is performed on failure -
-see C<errmode()>. The optional arguments are short-cuts to methods of
-the same name.
-
-If the I<$host> argument is given then the object is opened by
-connecting to TCP I<$port> on I<$host>. Also see C<open()>. The new
-object returned is given the following defaults in the absence of
-corresponding named parameters:
-
-=over 4
-
-=item
-
-The default I<Host> is C<"localhost">
-
-=item
-
-The default I<Port> is C<23>
-
-=item
-
-The default I<Prompt> is C<'/[\$%#E<gt>] $/'>
-
-=item
-
-The default I<Timeout> is C<10>
-
-=item
-
-The default I<Errmode> is C<"die">
-
-=item
-
-The default I<Output_record_separator> is C<"\n">. Note that I<Ors>
-is synonymous with I<Output_record_separator>.
-
-=item
-
-The default I<Input_record_separator> is C<"\n">. Note that I<Rs> is
-synonymous with I<Input_record_separator>.
-
-=item
-
-The default I<Binmode> is C<0>, which means do newline translation.
-
-=item
-
-The default I<Telnetmode> is C<1>, which means respond to TELNET
-commands in the data stream.
-
-=item
-
-The default I<Cmd_remove_mode> is C<"auto">
-
-=item
-
-The defaults for I<Dump_log>, I<Input_log>, I<Option_log>, and
-I<Output_log> are C<"">, which means that logging is turned-off.
-
-=back
-
-=back
-
-
-=over 4
-
-=item B<binmode> - toggle newline translation
-
- $mode = $obj->binmode;
-
- $prev = $obj->binmode($mode);
-
-This method controls whether or not sequences of carriage returns and
-line feeds (CR LF or more specifically C<"\015\012">) are translated.
-By default they are translated (i.e. binmode is C<0>).
-
-If no argument is given, the current mode is returned.
-
-If I<$mode> is C<1> then binmode is I<on> and newline translation is
-not done.
-
-If I<$mode> is C<0> then binmode is I<off> and newline translation is
-done. In the input stream, each sequence of CR LF is converted to
-C<"\n"> and in the output stream, each occurrence of C<"\n"> is
-converted to a sequence of CR LF.
-
-Note that input is always buffered. Changing binmode doesn't effect
-what's already been read into the buffer. Output is not buffered and
-changing binmode will have an immediate effect.
-
-=back
-
-
-=over 4
-
-=item B<break> - send TELNET break character
-
- $ok = $obj->break;
-
-This method sends the TELNET break character. This character is
-provided because it's a signal outside the ASCII character set which
-is currently given local meaning within many systems. It's intended
-to indicate that the Break Key or the Attention Key was hit.
-
-This method returns C<1> on success, or performs the error mode action
-on failure.
-
-=back
-
-
-=over 4
-
-=item B<buffer> - scalar reference to object's input buffer
-
- $ref = $obj->buffer;
-
-This method returns a scalar reference to the input buffer for
-I<$obj>. Data in the input buffer is data that has been read from the
-remote side but has yet to be read by the user. Modifications to the
-input buffer are returned by a subsequent read.
-
-=back
-
-
-=over 4
-
-=item B<buffer_empty> - discard all data in object's input buffer
-
- $obj->buffer_empty;
-
-This method removes all data in the input buffer for I<$obj>.
-
-=back
-
-
-=over 4
-
-=item B<close> - close object
-
- $ok = $obj->close;
-
-This method closes the socket, file, or pipe associated with the
-object. It always returns a value of C<1>.
-
-=back
-
-
-=over 4
-
-=item B<cmd> - issue command and retrieve output
-
- $ok = $obj->cmd($string);
- $ok = $obj->cmd(String => $string,
- [Output => $ref,]
- [Cmd_remove_mode => $mode,]
- [Errmode => $mode,]
- [Input_record_separator => $chars,]
- [Ors => $chars,]
- [Output_record_separator => $chars,]
- [Prompt => $match,]
- [Rs => $chars,]
- [Timeout => $secs,]);
-
- @output = $obj->cmd($string);
- @output = $obj->cmd(String => $string,
- [Output => $ref,]
- [Cmd_remove_mode => $mode,]
- [Errmode => $mode,]
- [Input_record_separator => $chars,]
- [Ors => $chars,]
- [Output_record_separator => $chars,]
- [Prompt => $match,]
- [Rs => $chars,]
- [Timeout => $secs,]);
-
-This method sends the command I<$string>, and reads the characters
-sent back by the command up until and including the matching prompt.
-It's assumed that the program to which you're sending is some kind of
-command prompting interpreter such as a shell.
-
-The command I<$string> is automatically appended with the
-output_record_separator, By default that's C<"\n">. This is similar
-to someone typing a command and hitting the return key. Set the
-output_record_separator to change this behavior.
-
-In a scalar context, the characters read from the remote side are
-discarded and C<1> is returned on success. On time-out, eof, or other
-failures, the error mode action is performed. See C<errmode()>.
-
-In a list context, just the output generated by the command is
-returned, one line per element. In other words, all the characters in
-between the echoed back command string and the prompt are returned.
-If the command happens to return no output, a list containing one
-element, the empty string is returned. This is so the list will
-indicate true in a boolean context. On time-out, eof, or other
-failures, the error mode action is performed. See C<errmode()>.
-
-The characters that matched the prompt may be retrieved using
-C<last_prompt()>.
-
-Many command interpreters echo back the command sent. In most
-situations, this method removes the first line returned from the
-remote side (i.e. the echoed back command). See C<cmd_remove_mode()>
-for more control over this feature.
-
-Use C<dump_log()> to debug when this method keeps timing-out and you
-don't think it should.
-
-Consider using a combination of C<print()> and C<waitfor()> as an
-alternative to this method when it doesn't do what you want, e.g. the
-command you send prompts for input.
-
-The I<Output> named parameter provides an alternative method of
-receiving command output. If you pass a scalar reference, all the
-output (even if it contains multiple lines) is returned in the
-referenced scalar. If you pass an array or hash reference, the lines
-of output are returned in the referenced array or hash. You can use
-C<input_record_separator()> to change the notion of what separates a
-line.
-
-Optional named parameters are provided to override the current
-settings of cmd_remove_mode, errmode, input_record_separator, ors,
-output_record_separator, prompt, rs, and timeout. Rs is synonymous
-with input_record_separator and ors is synonymous with
-output_record_separator.
-
-=back
-
-
-=over 4
-
-=item B<cmd_remove_mode> - toggle removal of echoed commands
-
- $mode = $obj->cmd_remove_mode;
-
- $prev = $obj->cmd_remove_mode($mode);
-
-This method controls how to deal with echoed back commands in the
-output returned by cmd(). Typically, when you send a command to the
-remote side, the first line of output returned is the command echoed
-back. Use this mode to remove the first line of output normally
-returned by cmd().
-
-If no argument is given, the current mode is returned.
-
-If I<$mode> is C<0> then the command output returned from cmd() has no
-lines removed. If I<$mode> is a positive integer, then the first
-I<$mode> lines of command output are stripped.
-
-By default, I<$mode> is set to C<"auto">. Auto means that whether or
-not the first line of command output is stripped, depends on whether
-or not the remote side offered to echo. By default, Net::Telnet
-always accepts an offer to echo by the remote side. You can change
-the default to reject such an offer using C<option_accept()>.
-
-A warning is printed to STDERR when attempting to set this attribute
-to something that's not C<"auto"> or a non-negative integer.
-
-=back
-
-
-=over 4
-
-=item B<dump_log> - log all I/O in dump format
-
- $fh = $obj->dump_log;
-
- $fh = $obj->dump_log($fh);
-
- $fh = $obj->dump_log($filename);
-
-This method starts or stops dump format logging of all the object's
-input and output. The dump format shows the blocks read and written
-in a hexadecimal and printable character format. This method is
-useful when debugging, however you might want to first try
-C<input_log()> as it's more readable.
-
-If no argument is given, the current log filehandle is returned. An
-empty string indicates logging is off.
-
-To stop logging, use an empty string as an argument.
-
-If an open filehandle is given, it is used for logging and returned.
-Otherwise, the argument is assumed to be the name of a file, the file
-is opened and a filehandle to it is returned. If the file can't be
-opened for writing, the error mode action is performed.
-
-=back
-
-
-=over 4
-
-=item B<eof> - end of file indicator
-
- $eof = $obj->eof;
-
-This method returns C<1> if end of file has been read, otherwise it
-returns an empty string. Because the input is buffered this isn't the
-same thing as I<$obj> has closed. In other words I<$obj> can be
-closed but there still can be stuff in the buffer to be read. Under
-this condition you can still read but you won't be able to write.
-
-=back
-
-
-=over 4
-
-=item B<errmode> - define action to be performed on error
-
- $mode = $obj->errmode;
-
- $prev = $obj->errmode($mode);
-
-This method gets or sets the action used when errors are encountered
-using the object. The first calling sequence returns the current
-error mode. The second calling sequence sets it to I<$mode> and
-returns the previous mode. Valid values for I<$mode> are C<"die">
-(the default), C<"return">, a I<coderef>, or an I<arrayref>.
-
-When mode is C<"die"> and an error is encountered using the object,
-then an error message is printed to standard error and the program
-dies.
-
-When mode is C<"return"> then the method generating the error places
-an error message in the object and returns an undefined value in a
-scalar context and an empty list in list context. The error message
-may be obtained using C<errmsg()>.
-
-When mode is a I<coderef>, then when an error is encountered
-I<coderef> is called with the error message as its first argument.
-Using this mode you may have your own subroutine handle errors. If
-I<coderef> itself returns then the method generating the error returns
-undefined or an empty list depending on context.
-
-When mode is an I<arrayref>, the first element of the array must be a
-I<coderef>. Any elements that follow are the arguments to I<coderef>.
-When an error is encountered, the I<coderef> is called with its
-arguments. Using this mode you may have your own subroutine handle
-errors. If the I<coderef> itself returns then the method generating
-the error returns undefined or an empty list depending on context.
-
-A warning is printed to STDERR when attempting to set this attribute
-to something that's not C<"die">, C<"return">, a I<coderef>, or an
-I<arrayref> whose first element isn't a I<coderef>.
-
-=back
-
-
-=over 4
-
-=item B<errmsg> - most recent error message
-
- $msg = $obj->errmsg;
-
- $prev = $obj->errmsg(@msgs);
-
-The first calling sequence returns the error message associated with
-the object. The empty string is returned if no error has been
-encountered yet. The second calling sequence sets the error message
-for the object to the concatenation of I<@msgs> and returns the
-previous error message. Normally, error messages are set internally
-by a method when an error is encountered.
-
-=back
-
-
-=over 4
-
-=item B<error> - perform the error mode action
-
- $obj->error(@msgs);
-
-This method concatenates I<@msgs> into a string and places it in the
-object as the error message. Also see C<errmsg()>. It then performs
-the error mode action. Also see C<errmode()>.
-
-If the error mode doesn't cause the program to die, then an undefined
-value or an empty list is returned depending on the context.
-
-This method is primarily used by this class or a sub-class to perform
-the user requested action when an error is encountered.
-
-=back
-
-
-=over 4
-
-=item B<fhopen> - use already open filehandle for I/O
-
- $ok = $obj->fhopen($fh);
-
-This method associates the open filehandle I<$fh> with I<$obj> for
-further I/O. Filehandle I<$fh> must already be opened.
-
-Suppose you want to use the features of this module to do I/O to
-something other than a TCP port, for example STDIN or a filehandle
-opened to read from a process. Instead of opening the object for I/O
-to a TCP port by using C<open()> or C<new()>, call this method
-instead.
-
-The value C<1> is returned success, the error mode action is performed
-on failure.
-
-=back
-
-
-=over 4
-
-=item B<get> - read block of data
-
- $data = $obj->get([Binmode => $mode,]
- [Errmode => $errmode,]
- [Telnetmode => $mode,]
- [Timeout => $secs,]);
-
-This method reads a block of data from the object and returns it along
-with any buffered data. If no buffered data is available to return,
-it will wait for data to read using the timeout specified in the
-object. You can override that timeout using I<$secs>. Also see
-C<timeout()>. If buffered data is available to return, it also checks
-for a block of data that can be immediately read.
-
-On eof an undefined value is returned. On time-out or other failures,
-the error mode action is performed. To distinguish between eof or an
-error occurring when the error mode is not set to C<"die">, use
-C<eof()>.
-
-Optional named parameters are provided to override the current
-settings of binmode, errmode, telnetmode, and timeout.
-
-=back
-
-
-=over 4
-
-=item B<getline> - read next line
-
- $line = $obj->getline([Binmode => $mode,]
- [Errmode => $errmode,]
- [Input_record_separator => $chars,]
- [Rs => $chars,]
- [Telnetmode => $mode,]
- [Timeout => $secs,]);
-
-This method reads and returns the next line of data from the object.
-You can use C<input_record_separator()> to change the notion of what
-separates a line. The default is C<"\n">. If a line isn't
-immediately available, this method blocks waiting for a line or a
-time-out.
-
-On eof an undefined value is returned. On time-out or other failures,
-the error mode action is performed. To distinguish between eof or an
-error occurring when the error mode is not set to C<"die">, use
-C<eof()>.
-
-Optional named parameters are provided to override the current
-settings of binmode, errmode, input_record_separator, rs, telnetmode,
-and timeout. Rs is synonymous with input_record_separator.
-
-=back
-
-
-=over 4
-
-=item B<getlines> - read next lines
-
- @lines = $obj->getlines([Binmode => $mode,]
- [Errmode => $errmode,]
- [Input_record_separator => $chars,]
- [Rs => $chars,]
- [Telnetmode => $mode,]
- [Timeout => $secs,]
- [All => $boolean,]);
-
-This method reads and returns all the lines of data from the object
-until end of file is read. You can use C<input_record_separator()> to
-change the notion of what separates a line. The default is C<"\n">.
-A time-out error occurs if all the lines can't be read within the
-time-out interval. See C<timeout()>.
-
-The behavior of this method was changed in version 3.03. Prior to
-version 3.03 this method returned just the lines available from the
-next read. To get that old behavior, use the optional named parameter
-I<All> and set I<$boolean> to C<""> or C<0>.
-
-If only eof is read then an empty list is returned. On time-out or
-other failures, the error mode action is performed. Use C<eof()> to
-distinguish between reading only eof or an error occurring when the
-error mode is not set to C<"die">.
-
-Optional named parameters are provided to override the current
-settings of binmode, errmode, input_record_separator, rs, telnetmode,
-and timeout. Rs is synonymous with input_record_separator.
-
-=back
-
-
-=over 4
-
-=item B<host> - name of remote host
-
- $host = $obj->host;
-
- $prev = $obj->host($host);
-
-This method designates the remote host for C<open()>. With no
-argument it returns the current host name set in the object. With an
-argument it sets the current host name to I<$host> and returns the
-previous host name. You may indicate the remote host using either a
-hostname or an IP address.
-
-The default value is C<"localhost">. It may also be set by C<open()>
-or C<new()>.
-
-=back
-
-
-=over 4
-
-=item B<input_log> - log all input
-
- $fh = $obj->input_log;
-
- $fh = $obj->input_log($fh);
-
- $fh = $obj->input_log($filename);
-
-This method starts or stops logging of input. This is useful when
-debugging. Also see C<dump_log()>. Because most command interpreters
-echo back commands received, it's likely all your output will also be
-in this log. Note that input logging occurs after newline
-translation. See C<binmode()> for details on newline translation.
-
-If no argument is given, the log filehandle is returned. An empty
-string indicates logging is off.
-
-To stop logging, use an empty string as an argument.
-
-If an open filehandle is given, it is used for logging and returned.
-Otherwise, the argument is assumed to be the name of a file, the file
-is opened for logging and a filehandle to it is returned. If the file
-can't be opened for writing, the error mode action is performed.
-
-=back
-
-
-=over 4
-
-=item B<input_record_separator> - input line delimiter
-
- $chars = $obj->input_record_separator;
-
- $prev = $obj->input_record_separator($chars);
-
-This method designates the line delimiter for input. It's used with
-C<getline()>, C<getlines()>, and C<cmd()> to determine lines in the
-input.
-
-With no argument this method returns the current input record
-separator set in the object. With an argument it sets the input
-record separator to I<$chars> and returns the previous value. Note
-that I<$chars> must have length.
-
-A warning is printed to STDERR when attempting to set this attribute
-to a string with no length.
-
-=back
-
-
-=over 4
-
-=item B<last_prompt> - last prompt read
-
- $string = $obj->last_prompt;
-
- $prev = $obj->last_prompt($string);
-
-With no argument this method returns the last prompt read by cmd() or
-login(). See C<prompt()>. With an argument it sets the last prompt
-read to I<$string> and returns the previous value. Normally, only
-internal methods set the last prompt.
-
-=back
-
-
-=over 4
-
-=item B<lastline> - last line read
-
- $line = $obj->lastline;
-
- $prev = $obj->lastline($line);
-
-This method retrieves the last line read from the object. This may be
-a useful error message when the remote side abnormally closes the
-connection. Typically the remote side will print an error message
-before closing.
-
-With no argument this method returns the last line read from the
-object. With an argument it sets the last line read to I<$line> and
-returns the previous value. Normally, only internal methods set the
-last line.
-
-=back
-
-
-=over 4
-
-=item B<login> - perform standard login
-
- $ok = $obj->login($username, $password);
-
- $ok = $obj->login(Name => $username,
- Password => $password,
- [Errmode => $mode,]
- [Prompt => $match,]
- [Timeout => $secs,]);
-
-This method performs a standard login by waiting for a login prompt
-and responding with I<$username>, then waiting for the password prompt
-and responding with I<$password>, and then waiting for the command
-interpreter prompt. If any of those prompts sent by the remote side
-don't match what's expected, this method will time-out, unless timeout
-is turned off.
-
-Login prompt must match either of these case insensitive patterns:
-
- /login[: ]*$/i
- /username[: ]*$/i
-
-Password prompt must match this case insensitive pattern:
-
- /password[: ]*$/i
-
-The command interpreter prompt must match the current setting of
-prompt. See C<prompt()>.
-
-Use C<dump_log()> to debug when this method keeps timing-out and you
-don't think it should.
-
-Consider using a combination of C<print()> and C<waitfor()> as an
-alternative to this method when it doesn't do what you want, e.g. the
-remote host doesn't prompt for a username.
-
-On success, C<1> is returned. On time out, eof, or other failures,
-the error mode action is performed. See C<errmode()>.
-
-Optional named parameters are provided to override the current
-settings of errmode, prompt, and timeout.
-
-=back
-
-
-=over 4
-
-=item B<max_buffer_length> - maximum size of input buffer
-
- $len = $obj->max_buffer_length;
-
- $prev = $obj->max_buffer_length($len);
-
-This method designates the maximum size of the input buffer. An error
-is generated when a read causes the buffer to exceed this limit. The
-default value is 1,048,576 bytes (1MB). The input buffer can grow
-much larger than the block size when you continuously read using
-C<getline()> or C<waitfor()> and the data stream contains no newlines
-or matching waitfor patterns.
-
-With no argument, this method returns the current maximum buffer
-length set in the object. With an argument it sets the maximum buffer
-length to I<$len> and returns the previous value. Values of I<$len>
-smaller than 512 will be adjusted to 512.
-
-A warning is printed to STDERR when attempting to set this attribute
-to something that isn't a positive integer.
-
-=back
-
-
-=over 4
-
-=item B<ofs> - field separator for print
-
- $chars = $obj->ofs
-
- $prev = $obj->ofs($chars);
-
-This method is synonymous with C<output_field_separator()>.
-
-=back
-
-
-=over 4
-
-=item B<open> - connect to port on remote host
-
- $ok = $obj->open($host);
-
- $ok = $obj->open([Host => $host,]
- [Port => $port,]
- [Errmode => $mode,]
- [Timeout => $secs,]);
-
-This method opens a TCP connection to I<$port> on I<$host>. If either
-argument is missing then the current value of C<host()> or C<port()>
-is used. Optional named parameters are provided to override the
-current setting of errmode and timeout.
-
-On success C<1> is returned. On time-out or other connection
-failures, the error mode action is performed. See C<errmode()>.
-
-Time-outs don't work for this method on machines that don't implement
-SIGALRM - most notably MS-Windows machines. For those machines, an
-error is returned when the system reaches its own time-out while
-trying to connect.
-
-A side effect of this method is to reset the alarm interval associated
-with SIGALRM.
-
-=back
-
-
-=over 4
-
-=item B<option_accept> - indicate willingness to accept a TELNET option
-
- $fh = $obj->option_accept([Do => $telopt,]
- [Dont => $telopt,]
- [Will => $telopt,]
- [Wont => $telopt,]);
-
-This method is used to indicate whether to accept or reject an offer
-to enable a TELNET option made by the remote side. If you're using
-I<Do> or I<Will> to indicate a willingness to enable, then a
-notification callback must have already been defined by a prior call
-to C<option_callback()>. See C<option_callback()> for details on
-receiving enable/disable notification of a TELNET option.
-
-You can give multiple I<Do>, I<Dont>, I<Will>, or I<Wont> arguments
-for different TELNET options in the same call to this method.
-
-The following example describes the meaning of the named parameters.
-A TELNET option, such as C<TELOPT_ECHO> used below, is an integer
-constant that you can import from Net::Telnet. See the source in file
-Telnet.pm for the complete list.
-
-=over 4
-
-=item
-
-I<Do> => C<TELOPT_ECHO>
-
-=over 4
-
-=item
-
-we'll accept an offer to enable the echo option on the local side
-
-=back
-
-=item
-
-I<Dont> => C<TELOPT_ECHO>
-
-=over 4
-
-=item
-
-we'll reject an offer to enable the echo option on the local side
-
-=back
-
-=item
-
-I<Will> => C<TELOPT_ECHO>
-
-=over 4
-
-=item
-
-we'll accept an offer to enable the echo option on the remote side
-
-=back
-
-=item
-
-I<Wont> => C<TELOPT_ECHO>
-
-=over 4
-
-=item
-
-we'll reject an offer to enable the echo option on the remote side
-
-=back
-
-=back
-
-=item
-
-Use C<option_send()> to send a request to the remote side to enable or
-disable a particular TELNET option.
-
-=back
-
-
-=over 4
-
-=item B<option_callback> - define the option negotiation callback
-
- $coderef = $obj->option_callback;
-
- $prev = $obj->option_callback($coderef);
-
-This method defines the callback subroutine that's called when a
-TELNET option is enabled or disabled. Once defined, the
-I<option_callback> may not be undefined. However, calling this method
-with a different I<$coderef> changes it.
-
-A warning is printed to STDERR when attempting to set this attribute
-to something that isn't a coderef.
-
-Here are the circumstances that invoke I<$coderef>:
-
-=over 4
-
-=item
-
-An option becomes enabled because the remote side requested an enable
-and C<option_accept()> had been used to arrange that it be accepted.
-
-=item
-
-The remote side arbitrarily decides to disable an option that is
-currently enabled. Note that Net::Telnet always accepts a request to
-disable from the remote side.
-
-=item
-
-C<option_send()> was used to send a request to enable or disable an
-option and the response from the remote side has just been received.
-Note, that if a request to enable is rejected then I<$coderef> is
-still invoked even though the option didn't change.
-
-=back
-
-=item
-
-Here are the arguments passed to I<&$coderef>:
-
- &$coderef($obj, $option, $is_remote,
- $is_enabled, $was_enabled, $buf_position);
-
-=over 4
-
-=item
-
-1. I<$obj> is the Net::Telnet object
-
-=item
-
-2. I<$option> is the TELNET option. Net::Telnet exports constants
-for the various TELNET options which just equate to an integer.
-
-=item
-
-3. I<$is_remote> is a boolean indicating for which side the option
-applies.
-
-=item
-
-4. I<$is_enabled> is a boolean indicating the option is enabled or
-disabled
-
-=item
-
-5. I<$was_enabled> is a boolean indicating the option was previously
-enabled or disabled
-
-=item
-
-6. I<$buf_position> is an integer indicating the position in the
-object's input buffer where the option takes effect. See C<buffer()>
-to access the object's input buffer.
-
-=back
-
-=back
-
-
-=over 4
-
-=item B<option_log> - log all TELNET options sent or received
-
- $fh = $obj->option_log;
-
- $fh = $obj->option_log($fh);
-
- $fh = $obj->option_log($filename);
-
-This method starts or stops logging of all TELNET options being sent
-or received. This is useful for debugging when you send options via
-C<option_send()> or you arrange to accept option requests from the
-remote side via C<option_accept()>. Also see C<dump_log()>.
-
-If no argument is given, the log filehandle is returned. An empty
-string indicates logging is off.
-
-To stop logging, use an empty string as an argument.
-
-If an open filehandle is given, it is used for logging and returned.
-Otherwise, the argument is assumed to be the name of a file, the file
-is opened for logging and a filehandle to it is returned. If the file
-can't be opened for writing, the error mode action is performed.
-
-=back
-
-
-=over 4
-
-=item B<option_send> - send TELNET option negotiation request
-
- $ok = $obj->option_send([Do => $telopt,]
- [Dont => $telopt,]
- [Will => $telopt,]
- [Wont => $telopt,]
- [Async => $boolean,]);
-
-This method is not yet implemented. Look for it in a future version.
-
-=back
-
-
-=over 4
-
-=item B<option_state> - get current state of a TELNET option
-
- $hashref = $obj->option_state($telopt);
-
-This method returns a hashref containing a copy of the current state
-of TELNET option I<$telopt>.
-
-Here are the values returned in the hash:
-
-=over 4
-
-=item
-
-I<$hashref>->{remote_enabled}
-
-=over 4
-
-=item
-
-boolean that indicates if the option is enabled on the remote side.
-
-=back
-
-=item
-
-I<$hashref>->{remote_enable_ok}
-
-=over 4
-
-=item
-
-boolean that indicates if it's ok to accept an offer to enable this
-option on the remote side.
-
-=back
-
-=item
-
-I<$hashref>->{remote_state}
-
-=over 4
-
-=item
-
-string used to hold the internal state of option negotiation for this
-option on the remote side.
-
-=back
-
-=item
-
-I<$hashref>->{local_enabled}
-
-=over 4
-
-=item
-
-boolean that indicates if the option is enabled on the local side.
-
-=back
-
-=item
-
-I<$hashref>->{local_enable_ok}
-
-=over 4
-
-=item
-
-boolean that indicates if it's ok to accept an offer to enable this
-option on the local side.
-
-=back
-
-=item
-
-I<$hashref>->{local_state}
-
-=over 4
-
-=item
-
-string used to hold the internal state of option negotiation for this
-option on the local side.
-
-=back
-
-=back
-
-=back
-
-
-=over 4
-
-=item B<ors> - output line delimiter
-
- $chars = $obj->ors;
-
- $prev = $obj->ors($chars);
-
-This method is synonymous with C<output_record_separator()>.
-
-=back
-
-
-=over 4
-
-=item B<output_field_separator> - field separator for print
-
- $chars = $obj->output_field_separator;
-
- $prev = $obj->output_field_separator($chars);
-
-This method designates the output field separator for C<print()>.
-Ordinarily the print method simply prints out the comma separated
-fields you specify. Set this to specify what's printed between
-fields.
-
-With no argument this method returns the current output field
-separator set in the object. With an argument it sets the output
-field separator to I<$chars> and returns the previous value.
-
-By default it's set to an empty string.
-
-=back
-
-
-=over 4
-
-=item B<output_log> - log all output
-
- $fh = $obj->output_log;
-
- $fh = $obj->output_log($fh);
-
- $fh = $obj->output_log($filename);
-
-This method starts or stops logging of output. This is useful when
-debugging. Also see C<dump_log()>. Because most command interpreters
-echo back commands received, it's likely all your output would also be
-in an input log. See C<input_log()>. Note that output logging occurs
-before newline translation. See C<binmode()> for details on newline
-translation.
-
-If no argument is given, the log filehandle is returned. An empty
-string indicates logging is off.
-
-To stop logging, use an empty string as an argument.
-
-If an open filehandle is given, it is used for logging and returned.
-Otherwise, the argument is assumed to be the name of a file, the file
-is opened for logging and a filehandle to it is returned. If the file
-can't be opened for writing, the error mode action is performed.
-
-=back
-
-
-=over 4
-
-=item B<output_record_separator> - output line delimiter
-
- $chars = $obj->output_record_separator;
-
- $prev = $obj->output_record_separator($chars);
-
-This method designates the output line delimiter for C<print()> and
-C<cmd()>. Set this to specify what's printed at the end of C<print()>
-and C<cmd()>.
-
-The output record separator is set to C<"\n"> by default, so there's
-no need to append all your commands with a newline. To avoid printing
-the output_record_separator use C<put()> or set the
-output_record_separator to an empty string.
-
-With no argument this method returns the current output record
-separator set in the object. With an argument it sets the output
-record separator to I<$chars> and returns the previous value.
-
-=back
-
-
-=over 4
-
-=item B<port> - remote port
-
- $port = $obj->port;
-
- $prev = $obj->port($port);
-
-This method designates the remote TCP port. With no argument this
-method returns the current port number. With an argument it sets the
-current port number to I<$port> and returns the previous port. If
-I<$port> is a TCP service name, then it's first converted to a port
-number using the perl function C<getservbyname()>.
-
-The default value is C<23>. It may also be set by C<open()> or
-C<new()>.
-
-A warning is printed to STDERR when attempting to set this attribute
-to something that's not a positive integer or a valid TCP service
-name.
-
-=back
-
-
-=over 4
-
-=item B<print> - write to object
-
- $ok = $obj->print(@list);
-
-This method writes I<@list> followed by the I<output_record_separator>
-to the open object and returns C<1> if all data was successfully
-written. On time-out or other failures, the error mode action is
-performed. See C<errmode()>.
-
-By default, the C<output_record_separator()> is set to C<"\n"> so all
-your commands automatically end with a newline. In most cases your
-output is being read by a command interpreter which won't accept a
-command until newline is read. This is similar to someone typing a
-command and hitting the return key. To avoid printing a trailing
-C<"\n"> use C<put()> instead or set the output_record_separator to an
-empty string.
-
-On failure, it's possible that some data was written. If you choose
-to try and recover from a print timing-out, use C<print_length()> to
-determine how much was written before the error occurred.
-
-You may also use the output field separator to print a string between
-the list elements. See C<output_field_separator()>.
-
-=back
-
-
-=over 4
-
-=item B<print_length> - number of bytes written by print
-
- $num = $obj->print_length;
-
-This returns the number of bytes successfully written by the most
-recent C<print()> or C<put()>.
-
-=back
-
-
-=over 4
-
-=item B<prompt> - pattern to match a prompt
-
- $matchop = $obj->prompt;
-
- $prev = $obj->prompt($matchop);
-
-This method sets the pattern used to find a prompt in the input
-stream. It must be a string representing a valid perl pattern match
-operator. The methods C<login()> and C<cmd()> try to read until
-matching the prompt. They will fail with a time-out error if the
-pattern you've chosen doesn't match what the remote side sends.
-
-With no argument this method returns the prompt set in the object.
-With an argument it sets the prompt to I<$matchop> and returns the
-previous value.
-
-The default prompt is C<'/[\$%#E<gt>] $/'>
-
-Always use single quotes, instead of double quotes, to construct
-I<$matchop> (e.g. C<'/bash\$ $/'>). If you're constructing a DOS like
-file path, you'll need to use four backslashes to represent one
-(e.g. C<'/c:\\\\users\\\\billE<gt>$/i'>).
-
-Of course don't forget about regexp metacharacters like C<.>, C<[>, or
-C<$>. You'll only need a single backslash to quote them. The anchor
-metacharacters C<^> and C<$> refer to positions in the input buffer.
-
-A warning is printed to STDERR when attempting to set this attribute
-with a match operator missing its opening delimiter.
-
-=back
-
-
-=over 4
-
-=item B<put> - write to object
-
- $ok = $obj->put($string);
-
- $ok = $obj->put(String => $string,
- [Binmode => $mode,]
- [Errmode => $errmode,]
- [Telnetmode => $mode,]
- [Timeout => $secs,]);
-
-This method writes I<$string> to the opened object and returns C<1> if
-all data was successfully written. This method is like C<print()>
-except that it doesn't write the trailing output_record_separator
-("\n" by default). On time-out or other failures, the error mode
-action is performed. See C<errmode()>.
-
-On failure, it's possible that some data was written. If you choose
-to try and recover from a put timing-out, use C<print_length()> to
-determine how much was written before the error occurred.
-
-Optional named parameters are provided to override the current
-settings of binmode, errmode, telnetmode, and timeout.
-
-=back
-
-
-=over 4
-
-=item B<rs> - input line delimiter
-
- $chars = $obj->rs;
-
- $prev = $obj->rs($chars);
-
-This method is synonymous with C<input_record_separator()>.
-
-=back
-
-
-=over 4
-
-=item B<telnetmode> - turn off/on telnet command interpretation
-
- $mode = $obj->telnetmode;
-
- $prev = $obj->telnetmode($mode);
-
-This method controls whether or not TELNET commands in the data stream
-are recognized and handled. The TELNET protocol uses certain
-character sequences sent in the data stream to control the session.
-If the port you're connecting to isn't using the TELNET protocol, then
-you should turn this mode off. The default is I<on>.
-
-If no argument is given, the current mode is returned.
-
-If I<$mode> is C<0> then telnet mode is off. If I<$mode> is C<1> then
-telnet mode is on.
-
-=back
-
-
-=over 4
-
-=item B<timed_out> - time-out indicator
-
- $boolean = $obj->timed_out;
-
- $prev = $obj->timed_out($boolean);
-
-This method indicates if a previous read, write, or open method
-timed-out. Remember that timing-out is itself an error. To be able
-to invoke C<timed_out()> after a time-out error, you'd have to change
-the default error mode to something other than C<"die">. See
-C<errmode()>.
-
-With no argument this method returns C<1> if the previous method
-timed-out. With an argument it sets the indicator. Normally, only
-internal methods set this indicator.
-
-=back
-
-
-=over 4
-
-=item B<timeout> - I/O time-out interval
-
- $secs = $obj->timeout;
-
- $prev = $obj->timeout($secs);
-
-This method sets the timeout interval that's used when performing I/O
-or connecting to a port. When a method doesn't complete within the
-timeout interval then it's an error and the error mode action is
-performed.
-
-A timeout may be expressed as a relative or absolute value. If
-I<$secs> is greater than or equal to the time the program started, as
-determined by $^T, then it's an absolute time value for when time-out
-occurs. The perl function C<time()> may be used to obtain an absolute
-time value. For a relative time-out value less than $^T, time-out
-happens I<$secs> from when the method begins.
-
-If I<$secs> is C<0> then time-out occurs if the data cannot be
-immediately read or written. Use the undefined value to turn off
-timing-out completely.
-
-With no argument this method returns the timeout set in the object.
-With an argument it sets the timeout to I<$secs> and returns the
-previous value. The default timeout value is C<10> seconds.
-
-A warning is printed to STDERR when attempting to set this attribute
-to something that's not an C<undef> or a non-negative integer.
-
-=back
-
-
-=over 4
-
-=item B<waitfor> - wait for pattern in the input
-
- $ok = $obj->waitfor($matchop);
- $ok = $obj->waitfor([Match => $matchop,]
- [String => $string,]
- [Binmode => $mode,]
- [Errmode => $errmode,]
- [Telnetmode => $mode,]
- [Timeout => $secs,]);
-
- ($prematch, $match) = $obj->waitfor($matchop);
- ($prematch, $match) = $obj->waitfor([Match => $matchop,]
- [String => $string,]
- [Binmode => $mode,]
- [Errmode => $errmode,]
- [Telnetmode => $mode,]
- [Timeout => $secs,]);
-
-This method reads until a pattern match or string is found in the
-input stream. All the characters before and including the match are
-removed from the input stream.
-
-In a list context the characters before the match and the matched
-characters are returned in I<$prematch> and I<$match>. In a scalar
-context, the matched characters and all characters before it are
-discarded and C<1> is returned on success. On time-out, eof, or other
-failures, for both list and scalar context, the error mode action is
-performed. See C<errmode()>.
-
-You can specify more than one pattern or string by simply providing
-multiple I<Match> and/or I<String> named parameters. A I<$matchop>
-must be a string representing a valid Perl pattern match operator.
-The I<$string> is just a substring to find in the input stream.
-
-Use C<dump_log()> to debug when this method keeps timing-out and you
-don't think it should.
-
-An optional named parameter is provided to override the current
-setting of timeout.
-
-To avoid unexpected backslash interpretation, always use single quotes
-instead of double quotes to construct a match operator argument for
-C<prompt()> and C<waitfor()> (e.g. C<'/bash\$ $/'>). If you're
-constructing a DOS like file path, you'll need to use four backslashes
-to represent one (e.g. C<'/c:\\\\users\\\\billE<gt>$/i'>).
-
-Of course don't forget about regexp metacharacters like C<.>, C<[>, or
-C<$>. You'll only need a single backslash to quote them. The anchor
-metacharacters C<^> and C<$> refer to positions in the input buffer.
-
-Optional named parameters are provided to override the current
-settings of binmode, errmode, telnetmode, and timeout.
-
-=back
-
-
-=head1 SEE ALSO
-
-=over 2
-
-=item RFC 854
-
-S<TELNET Protocol Specification>
-
-S<ftp://ftp.isi.edu/in-notes/rfc854.txt>
-
-=item RFC 1143
-
-S<Q Method of Implementing TELNET Option Negotiation>
-
-S<ftp://ftp.isi.edu/in-notes/rfc1143.txt>
-
-=item TELNET Option Assignments
-
-S<http://www.iana.org/assignments/telnet-options>
-
-=back
-
-
-=head1 EXAMPLES
-
-This example gets the current weather forecast for Brainerd, Minnesota.
-
- my ($forecast, $t);
-
- use Net::Telnet ();
- $t = new Net::Telnet;
- $t->open("rainmaker.wunderground.com");
-
- ## Wait for first prompt and "hit return".
- $t->waitfor('/continue:.*$/');
- $t->print("");
-
- ## Wait for second prompt and respond with city code.
- $t->waitfor('/city code.*$/');
- $t->print("BRD");
-
- ## Read and print the first page of forecast.
- ($forecast) = $t->waitfor('/[ \t]+press return to continue/i');
- print $forecast;
-
- exit;
-
-
-This example checks a POP server to see if you have mail.
-
- my ($hostname, $line, $passwd, $pop, $username);
-
- $hostname = "your_destination_host_here";
- $username = "your_username_here";
- $passwd = "your_password_here";
-
- use Net::Telnet ();
- $pop = new Net::Telnet (Telnetmode => 0);
- $pop->open(Host => $hostname,
- Port => 110);
-
-
- ## Read connection message.
- $line = $pop->getline;
- die $line unless $line =~ /^\+OK/;
-
- ## Send user name.
- $pop->print("user $username");
- $line = $pop->getline;
- die $line unless $line =~ /^\+OK/;
-
- ## Send password.
- $pop->print("pass $passwd");
- $line = $pop->getline;
- die $line unless $line =~ /^\+OK/;
-
- ## Request status of messages.
- $pop->print("list");
- $line = $pop->getline;
- print $line;
-
- exit;
-
-
-Here's an example that uses the ssh program to connect to a remote
-host. Because the ssh program reads and writes to its controlling
-terminal, the IO::Pty module is used to create a new pseudo terminal
-for use by ssh. A new Net::Telnet object is then created to read and
-write to that pseudo terminal. To use the code below, substitute
-"changeme" with the actual host, user, password, and command prompt.
-
- ## Main program.
- {
- my ($pty, $ssh, @lines);
- my $host = "changeme";
- my $user = "changeme";
- my $password = "changeme";
- my $prompt = '/changeme:~> $/';
-
- ## Start ssh program.
- $pty = &spawn("ssh", "-l", $user, $host); # spawn() defined below
-
- ## Create a Net::Telnet object to perform I/O on ssh's tty.
- use Net::Telnet;
- $ssh = new Net::Telnet (-fhopen => $pty,
- -prompt => $prompt,
- -telnetmode => 0,
- -cmd_remove_mode => 1,
- -output_record_separator => "\r");
-
- ## Login to remote host.
- $ssh->waitfor(-match => '/password: ?$/i',
- -errmode => "return")
- or die "problem connecting to host: ", $ssh->lastline;
- $ssh->print($password);
- $ssh->waitfor(-match => $ssh->prompt,
- -errmode => "return")
- or die "login failed: ", $ssh->lastline;
-
- ## Send command, get and print its output.
- @lines = $ssh->cmd("who");
- print @lines;
-
- exit;
- } # end main program
-
- sub spawn {
- my(@cmd) = @_;
- my($pid, $pty, $tty, $tty_fd);
-
- ## Create a new pseudo terminal.
- use IO::Pty ();
- $pty = new IO::Pty
- or die $!;
-
- ## Execute the program in another process.
- unless ($pid = fork) { # child process
- die "problem spawning program: $!\n" unless defined $pid;
-
- ## Disassociate process from existing controlling terminal.
- use POSIX ();
- POSIX::setsid
- or die "setsid failed: $!";
-
- ## Associate process with a new controlling terminal.
- $tty = $pty->slave;
- $tty_fd = $tty->fileno;
- close $pty;
-
- ## Make stdio use the new controlling terminal.
- open STDIN, "<&$tty_fd" or die $!;
- open STDOUT, ">&$tty_fd" or die $!;
- open STDERR, ">&STDOUT" or die $!;
- close $tty;
-
- ## Execute requested program.
- exec @cmd
- or die "problem executing $cmd[0]\n";
- } # end child process
-
- $pty;
- } # end sub spawn
-
-
-Here's an example that changes a user's login password. Because the
-passwd program always prompts for passwords on its controlling
-terminal, the IO::Pty module is used to create a new pseudo terminal
-for use by passwd. A new Net::Telnet object is then created to read
-and write to that pseudo terminal. To use the code below, substitute
-"changeme" with the actual old and new passwords.
-
- my ($pty, $passwd);
- my $oldpw = "changeme";
- my $newpw = "changeme";
-
- ## Start passwd program.
- $pty = &spawn("passwd"); # spawn() defined above
-
- ## Create a Net::Telnet object to perform I/O on passwd's tty.
- use Net::Telnet;
- $passwd = new Net::Telnet (-fhopen => $pty,
- -timeout => 2,
- -output_record_separator => "\r",
- -telnetmode => 0,
- -cmd_remove_mode => 1);
- $passwd->errmode("return");
-
- ## Send existing password.
- $passwd->waitfor('/password: ?$/i')
- or die "no old password prompt: ", $passwd->lastline;
- $passwd->print($oldpw);
-
- ## Send new password.
- $passwd->waitfor('/new password: ?$/i')
- or die "bad old password: ", $passwd->lastline;
- $passwd->print($newpw);
-
- ## Send new password verification.
- $passwd->waitfor('/new password: ?$/i')
- or die "bad new password: ", $passwd->lastline;
- $passwd->print($newpw);
-
- ## Display success or failure.
- $passwd->waitfor('/changed/')
- or die "bad new password: ", $passwd->lastline;
- print $passwd->lastline;
-
- $passwd->close;
- exit;
-
-
-Here's an example you can use to down load a file of any type. The
-file is read from the remote host's standard output using cat. To
-prevent any output processing, the remote host's standard output is
-put in raw mode using the Bourne shell. The Bourne shell is used
-because some shells, notably tcsh, prevent changing tty modes. Upon
-completion, FTP style statistics are printed to stderr.
-
- my ($block, $filename, $host, $hostname, $k_per_sec, $line,
- $num_read, $passwd, $prevblock, $prompt, $size, $size_bsd,
- $size_sysv, $start_time, $total_time, $username);
-
- $hostname = "your_destination_host_here";
- $username = "your_username_here";
- $passwd = "your_password_here";
- $filename = "your_download_file_here";
-
- ## Connect and login.
- use Net::Telnet ();
- $host = new Net::Telnet (Timeout => 30,
- Prompt => '/[%#>] $/');
- $host->open($hostname);
- $host->login($username, $passwd);
-
- ## Make sure prompt won't match anything in send data.
- $prompt = "_funkyPrompt_";
- $host->prompt("/$prompt\$/");
- $host->cmd("set prompt = '$prompt'");
-
- ## Get size of file.
- ($line) = $host->cmd("/bin/ls -l $filename");
- ($size_bsd, $size_sysv) = (split ' ', $line)[3,4];
- if ($size_sysv =~ /^\d+$/) {
- $size = $size_sysv;
- }
- elsif ($size_bsd =~ /^\d+$/) {
- $size = $size_bsd;
- }
- else {
- die "$filename: no such file on $hostname";
- }
-
- ## Start sending the file.
- binmode STDOUT;
- $host->binmode(1);
- $host->print("/bin/sh -c 'stty raw; cat $filename'");
- $host->getline; # discard echoed back line
-
- ## Read file a block at a time.
- $num_read = 0;
- $prevblock = "";
- $start_time = time;
- while (($block = $host->get) and ($block !~ /$prompt$/o)) {
- if (length $block >= length $prompt) {
- print $prevblock;
- $num_read += length $prevblock;
- $prevblock = $block;
- }
- else {
- $prevblock .= $block;
- }
-
- }
- $host->close;
-
- ## Print last block without trailing prompt.
- $prevblock .= $block;
- $prevblock =~ s/$prompt$//;
- print $prevblock;
- $num_read += length $prevblock;
- die "error: expected size $size, received size $num_read\n"
- unless $num_read == $size;
-
- ## Print totals.
- $total_time = (time - $start_time) || 1;
- $k_per_sec = ($size / 1024) / $total_time;
- $k_per_sec = sprintf "%3.1f", $k_per_sec;
- warn("$num_read bytes received in $total_time seconds ",
- "($k_per_sec Kbytes/s)\n");
-
- exit;
-
-
-=head1 AUTHOR
-
-Jay Rogers <jay@rgrs.com>
-
-
-=head1 COPYRIGHT
-
-Copyright 1997, 2000, 2002 by Jay Rogers. All rights reserved.
-This program is free software; you can redistribute it and/or
-modify it under the same terms as Perl itself.
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/PAR/Dist.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/PAR/Dist.pm
deleted file mode 100644
index d707451a495..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/PAR/Dist.pm
+++ /dev/null
@@ -1,1191 +0,0 @@
-package PAR::Dist;
-require Exporter;
-use vars qw/$VERSION @ISA @EXPORT @EXPORT_OK/;
-
-$VERSION = '0.29';
-@ISA = 'Exporter';
-@EXPORT = qw/
- blib_to_par
- install_par
- uninstall_par
- sign_par
- verify_par
- merge_par
- remove_man
- get_meta
- generate_blib_stub
-/;
-
-@EXPORT_OK = qw/
- parse_dist_name
- contains_binaries
-/;
-
-use strict;
-use Carp qw/carp croak/;
-use File::Spec;
-
-=head1 NAME
-
-PAR::Dist - Create and manipulate PAR distributions
-
-=head1 VERSION
-
-This document describes version 0.28 of PAR::Dist, released Feb 5, 2008.
-
-=head1 SYNOPSIS
-
-As a shell command:
-
- % perl -MPAR::Dist -eblib_to_par
-
-In programs:
-
- use PAR::Dist;
-
- my $dist = blib_to_par(); # make a PAR file using ./blib/
- install_par($dist); # install it into the system
- uninstall_par($dist); # uninstall it from the system
- sign_par($dist); # sign it using Module::Signature
- verify_par($dist); # verify it using Module::Signature
-
- install_par("http://foo.com/DBI-1.37-MSWin32-5.8.0.par"); # works too
- install_par("http://foo.com/DBI-1.37"); # auto-appends archname + perlver
- install_par("cpan://SMUELLER/PAR-Packer-0.975"); # uses CPAN author directory
-
-=head1 DESCRIPTION
-
-This module creates and manipulates I<PAR distributions>. They are
-architecture-specific B<PAR> files, containing everything under F<blib/>
-of CPAN distributions after their C<make> or C<Build> stage, a
-F<META.yml> describing metadata of the original CPAN distribution,
-and a F<MANIFEST> detailing all files within it. Digitally signed PAR
-distributions will also contain a F<SIGNATURE> file.
-
-The naming convention for such distributions is:
-
- $NAME-$VERSION-$ARCH-$PERL_VERSION.par
-
-For example, C<PAR-Dist-0.01-i386-freebsd-5.8.0.par> corresponds to the
-0.01 release of C<PAR-Dist> on CPAN, built for perl 5.8.0 running on
-C<i386-freebsd>.
-
-=head1 FUNCTIONS
-
-Several functions are exported by default. Unless otherwise noted,
-they can take either a hash of
-named arguments, a single argument (taken as C<$path> by C<blib_to_par>
-and C<$dist> by other functions), or no arguments (in which case
-the first PAR file in the current directory is used).
-
-Therefore, under a directory containing only a single F<test.par>, all
-invocations below are equivalent:
-
- % perl -MPAR::Dist -e"install_par( dist => 'test.par' )"
- % perl -MPAR::Dist -e"install_par( 'test.par' )"
- % perl -MPAR::Dist -einstall_par;
-
-If C<$dist> resembles a URL, C<LWP::Simple::mirror> is called to mirror it
-locally under C<$ENV{PAR_TEMP}> (or C<$TEMP/par/> if unspecified), and the
-function will act on the fetched local file instead. If the URL begins
-with C<cpan://AUTHOR/>, it will be expanded automatically to the author's CPAN
-directory (e.g. C<http://www.cpan.org/modules/by-authors/id/A/AU/AUTHOR/>).
-
-If C<$dist> does not have a file extension beginning with a letter or
-underscore, a dash and C<$suffix> ($ARCH-$PERL_VERSION.par by default)
-will be appended to it.
-
-=head2 blib_to_par
-
-Takes key/value pairs as parameters or a single parameter indicating the
-path that contains the F<blib/> subdirectory.
-
-Builds a PAR distribution from the F<blib/> subdirectory under C<path>, or
-under the current directory if unspecified. If F<blib/> does not exist,
-it automatically runs F<Build>, F<make>, F<Build.PL> or F<Makefile.PL> to
-create it.
-
-Returns the filename or the generated PAR distribution.
-
-Valid parameters are:
-
-=over 2
-
-=item path
-
-Sets the path which contains the F<blib/> subdirectory from which the PAR
-distribution will be generated.
-
-=item name, version, suffix
-
-These attributes set the name, version and platform specific suffix
-of the distribution. Name and version can be automatically
-determined from the distributions F<META.yml> or F<Makefile.PL> files.
-
-The suffix is generated from your architecture name and your version of
-perl by default.
-
-=item dist
-
-The output filename for the PAR distribution.
-
-=back
-
-=cut
-
-sub blib_to_par {
- @_ = (path => @_) if @_ == 1;
-
- my %args = @_;
- require Config;
-
-
- # don't use 'my $foo ... if ...' it creates a static variable!
- my $dist;
- my $path = $args{path};
- $dist = File::Spec->rel2abs($args{dist}) if $args{dist};
- my $name = $args{name};
- my $version = $args{version};
- my $suffix = $args{suffix} || "$Config::Config{archname}-$Config::Config{version}.par";
- my $cwd;
-
- if (defined $path) {
- require Cwd;
- $cwd = Cwd::cwd();
- chdir $path;
- }
-
- _build_blib() unless -d "blib";
-
- my @files;
- open MANIFEST, ">", File::Spec->catfile("blib", "MANIFEST") or die $!;
- open META, ">", File::Spec->catfile("blib", "META.yml") or die $!;
-
- require File::Find;
- File::Find::find( sub {
- next unless $File::Find::name;
- (-r && !-d) and push ( @files, substr($File::Find::name, 5) );
- } , 'blib' );
-
- print MANIFEST join(
- "\n",
- ' <!-- accessible as jar:file:///NAME.par!/MANIFEST in compliant browsers -->',
- (sort @files),
- q( # <html><body onload="var X=document.body.innerHTML.split(/\n/);var Y='<iframe src=&quot;META.yml&quot; style=&quot;float:right;height:40%;width:40%&quot;></iframe><ul>';for(var x in X){if(!X[x].match(/^\s*#/)&&X[x].length)Y+='<li><a href=&quot;'+X[x]+'&quot;>'+X[x]+'</a>'}document.body.innerHTML=Y">)
- );
- close MANIFEST;
-
- if (open(OLD_META, "META.yml")) {
- while (<OLD_META>) {
- if (/^distribution_type:/) {
- print META "distribution_type: par\n";
- }
- else {
- print META $_;
- }
-
- if (/^name:\s+(.*)/) {
- $name ||= $1;
- $name =~ s/::/-/g;
- }
- elsif (/^version:\s+.*Module::Build::Version/) {
- while (<OLD_META>) {
- /^\s+original:\s+(.*)/ or next;
- $version ||= $1;
- last;
- }
- }
- elsif (/^version:\s+(.*)/) {
- $version ||= $1;
- }
- }
- close OLD_META;
- close META;
- }
-
- if ((!$name or !$version) and open(MAKEFILE, "Makefile")) {
- while (<MAKEFILE>) {
- if (/^DISTNAME\s+=\s+(.*)$/) {
- $name ||= $1;
- }
- elsif (/^VERSION\s+=\s+(.*)$/) {
- $version ||= $1;
- }
- }
- }
-
- if (not defined($name) or not defined($version)) {
- # could not determine name or version. Error.
- my $what;
- if (not defined $name) {
- $what = 'name';
- $what .= ' and version' if not defined $version;
- }
- elsif (not defined $version) {
- $what = 'version';
- }
-
- carp("I was unable to determine the $what of the PAR distribution. Please create a Makefile or META.yml file from which we can infer the information or just specify the missing information as an option to blib_to_par.");
- return();
- }
-
- $name =~ s/\s+$//;
- $version =~ s/\s+$//;
-
- my $file = "$name-$version-$suffix";
- unlink $file if -f $file;
-
- print META << "YAML" if fileno(META);
-name: $name
-version: $version
-build_requires: {}
-conflicts: {}
-dist_name: $file
-distribution_type: par
-dynamic_config: 0
-generated_by: 'PAR::Dist version $PAR::Dist::VERSION'
-license: unknown
-YAML
- close META;
-
- mkdir('blib', 0777);
- chdir('blib');
- _zip(dist => File::Spec->catfile(File::Spec->updir, $file)) or die $!;
- chdir(File::Spec->updir);
-
- unlink File::Spec->catfile("blib", "MANIFEST");
- unlink File::Spec->catfile("blib", "META.yml");
-
- $dist ||= File::Spec->catfile($cwd, $file) if $cwd;
-
- if ($dist and $file ne $dist) {
- rename( $file => $dist );
- $file = $dist;
- }
-
- my $pathname = File::Spec->rel2abs($file);
- if ($^O eq 'MSWin32') {
- $pathname =~ s!\\!/!g;
- $pathname =~ s!:!|!g;
- };
- print << ".";
-Successfully created binary distribution '$file'.
-Its contents are accessible in compliant browsers as:
- jar:file://$pathname!/MANIFEST
-.
-
- chdir $cwd if $cwd;
- return $file;
-}
-
-sub _build_blib {
- if (-e 'Build') {
- system($^X, "Build");
- }
- elsif (-e 'Makefile') {
- system($Config::Config{make});
- }
- elsif (-e 'Build.PL') {
- system($^X, "Build.PL");
- system($^X, "Build");
- }
- elsif (-e 'Makefile.PL') {
- system($^X, "Makefile.PL");
- system($Config::Config{make});
- }
-}
-
-=head2 install_par
-
-Installs a PAR distribution into the system, using
-C<ExtUtils::Install::install_default>.
-
-Valid parameters are:
-
-=over 2
-
-=item dist
-
-The .par file to install. The heuristics outlined in the B<FUNCTIONS>
-section above apply.
-
-=item prefix
-
-This string will be prepended to all installation paths.
-If it isn't specified, the environment variable
-C<PERL_INSTALL_ROOT> is used as a prefix.
-
-=back
-
-Additionally, you can use several parameters to change the default
-installation destinations. You don't usually have to worry about this
-unless you are installing into a user-local directory.
-The following section outlines the parameter names and default settings:
-
- Parameter From To
- inst_lib blib/lib $Config{installsitelib} (*)
- inst_archlib blib/arch $Config{installsitearch}
- inst_script blib/script $Config{installscript}
- inst_bin blib/bin $Config{installbin}
- inst_man1dir blib/man1 $Config{installman1dir}
- inst_man3dir blib/man3 $Config{installman3dir}
- packlist_read $Config{sitearchexp}/auto/$name/.packlist
- packlist_write $Config{installsitearch}/auto/$name/.packlist
-
-The C<packlist_write> parameter is used to control where the F<.packlist>
-file is written to. (Necessary for uninstallation.)
-The C<packlist_read> parameter specifies a .packlist file to merge in if
-it exists. By setting any of the above installation targets to C<undef>,
-you can remove that target altogether. For example, passing
-C<inst_man1dir => undef, inst_man3dir => undef> means that the contained
-manual pages won't be installed. This is not available for the packlists.
-
-Finally, you may specify a C<custom_targets> parameter. Its value should be
-a reference to a hash of custom installation targets such as
-
- custom_targets => { 'blib/my_data' => '/some/path/my_data' }
-
-You can use this to install the F<.par> archives contents to arbitrary
-locations.
-
-If only a single parameter is given, it is treated as the C<dist>
-parameter.
-
-=cut
-
-sub install_par {
- my %args = &_args;
- _install_or_uninstall(%args, action => 'install');
-}
-
-=head2 uninstall_par
-
-Uninstalls all previously installed contents of a PAR distribution,
-using C<ExtUtils::Install::uninstall>.
-
-Takes almost the same parameters as C<install_par>, but naturally,
-the installation target parameters do not apply. The only exception
-to this is the C<packlist_read> parameter which specifies the
-F<.packlist> file to read the list of installed files from.
-It defaults to C<$Config::Config{installsitearch}/auto/$name/.packlist>.
-
-=cut
-
-sub uninstall_par {
- my %args = &_args;
- _install_or_uninstall(%args, action => 'uninstall');
-}
-
-sub _install_or_uninstall {
- my %args = &_args;
- my $name = $args{name};
- my $action = $args{action};
-
- my %ENV_copy = %ENV;
- $ENV{PERL_INSTALL_ROOT} = $args{prefix} if defined $args{prefix};
-
- require Cwd;
- my $old_dir = Cwd::cwd();
-
- my ($dist, $tmpdir) = _unzip_to_tmpdir( dist => $args{dist}, subdir => 'blib' );
-
- if ( open (META, File::Spec->catfile('blib', 'META.yml')) ) {
- while (<META>) {
- next unless /^name:\s+(.*)/;
- $name = $1;
- $name =~ s/\s+$//;
- last;
- }
- close META;
- }
- return if not defined $name or $name eq '';
-
- if (-d 'script') {
- require ExtUtils::MY;
- foreach my $file (glob("script/*")) {
- next unless -T $file;
- ExtUtils::MY->fixin($file);
- chmod(0555, $file);
- }
- }
-
- $name =~ s{::|-}{/}g;
- require ExtUtils::Install;
-
- my $rv;
- if ($action eq 'install') {
- my $target = _installation_target( File::Spec->curdir, $name, \%args );
- my $custom_targets = $args{custom_targets} || {};
- $target->{$_} = $custom_targets->{$_} foreach keys %{$custom_targets};
-
- $rv = ExtUtils::Install::install($target, 1, 0, 0);
- }
- elsif ($action eq 'uninstall') {
- require Config;
- $rv = ExtUtils::Install::uninstall(
- $args{packlist_read}||"$Config::Config{installsitearch}/auto/$name/.packlist"
- );
- }
-
- %ENV = %ENV_copy;
-
- chdir($old_dir);
- File::Path::rmtree([$tmpdir]);
- return $rv;
-}
-
-# Returns the default installation target as used by
-# ExtUtils::Install::install(). First parameter should be the base
-# directory containing the blib/ we're installing from.
-# Second parameter should be the name of the distribution for the packlist
-# paths. Third parameter may be a hash reference with user defined keys for
-# the target hash. In fact, any contents that do not start with 'inst_' are
-# skipped.
-sub _installation_target {
- require Config;
- my $dir = shift;
- my $name = shift;
- my $user = shift || {};
-
- # accepted sources (and user overrides)
- my %sources = (
- inst_lib => File::Spec->catdir($dir,"blib","lib"),
- inst_archlib => File::Spec->catdir($dir,"blib","arch"),
- inst_bin => File::Spec->catdir($dir,'blib','bin'),
- inst_script => File::Spec->catdir($dir,'blib','script'),
- inst_man1dir => File::Spec->catdir($dir,'blib','man1'),
- inst_man3dir => File::Spec->catdir($dir,'blib','man3'),
- packlist_read => 'read',
- packlist_write => 'write',
- );
-
-
- # default targets
- my $target = {
- read => $Config::Config{sitearchexp}."/auto/$name/.packlist",
- write => $Config::Config{installsitearch}."/auto/$name/.packlist",
- $sources{inst_lib}
- => (_directory_not_empty($sources{inst_archlib}))
- ? $Config::Config{installsitearch}
- : $Config::Config{installsitelib},
- $sources{inst_archlib} => $Config::Config{installsitearch},
- $sources{inst_bin} => $Config::Config{installbin} ,
- $sources{inst_script} => $Config::Config{installscript},
- $sources{inst_man1dir} => $Config::Config{installman1dir},
- $sources{inst_man3dir} => $Config::Config{installman3dir},
- };
-
- # Included for future support for ${flavour}perl external lib installation
-# if ($Config::Config{flavour_perl}) {
-# my $ext = File::Spec->catdir($dir, 'blib', 'ext');
-# # from => to
-# $sources{inst_external_lib} = File::Spec->catdir($ext, 'lib');
-# $sources{inst_external_bin} = File::Spec->catdir($ext, 'bin');
-# $sources{inst_external_include} = File::Spec->catdir($ext, 'include');
-# $sources{inst_external_src} = File::Spec->catdir($ext, 'src');
-# $target->{ $sources{inst_external_lib} } = $Config::Config{flavour_install_lib};
-# $target->{ $sources{inst_external_bin} } = $Config::Config{flavour_install_bin};
-# $target->{ $sources{inst_external_include} } = $Config::Config{flavour_install_include};
-# $target->{ $sources{inst_external_src} } = $Config::Config{flavour_install_src};
-# }
-
- # insert user overrides
- foreach my $key (keys %$user) {
- my $value = $user->{$key};
- if (not defined $value and $key ne 'packlist_read' and $key ne 'packlist_write') {
- # undef means "remove"
- delete $target->{ $sources{$key} };
- }
- elsif (exists $sources{$key}) {
- # overwrite stuff, don't let the user create new entries
- $target->{ $sources{$key} } = $value;
- }
- }
-
- return $target;
-}
-
-sub _directory_not_empty {
- require File::Find;
- my($dir) = @_;
- my $files = 0;
- File::Find::find(sub {
- return if $_ eq ".exists";
- if (-f) {
- $File::Find::prune++;
- $files = 1;
- }
- }, $dir);
- return $files;
-}
-
-=head2 sign_par
-
-Digitally sign a PAR distribution using C<gpg> or B<Crypt::OpenPGP>,
-via B<Module::Signature>.
-
-=cut
-
-sub sign_par {
- my %args = &_args;
- _verify_or_sign(%args, action => 'sign');
-}
-
-=head2 verify_par
-
-Verify the digital signature of a PAR distribution using C<gpg> or
-B<Crypt::OpenPGP>, via B<Module::Signature>.
-
-Returns a boolean value indicating whether verification passed; C<$!>
-is set to the return code of C<Module::Signature::verify>.
-
-=cut
-
-sub verify_par {
- my %args = &_args;
- $! = _verify_or_sign(%args, action => 'verify');
- return ( $! == Module::Signature::SIGNATURE_OK() );
-}
-
-=head2 merge_par
-
-Merge two or more PAR distributions into one. First argument must
-be the name of the distribution you want to merge all others into.
-Any following arguments will be interpreted as the file names of
-further PAR distributions to merge into the first one.
-
- merge_par('foo.par', 'bar.par', 'baz.par')
-
-This will merge the distributions C<foo.par>, C<bar.par> and C<baz.par>
-into the distribution C<foo.par>. C<foo.par> will be overwritten!
-The original META.yml of C<foo.par> is retained.
-
-=cut
-
-sub merge_par {
- my $base_par = shift;
- my @additional_pars = @_;
- require Cwd;
- require File::Copy;
- require File::Path;
- require File::Find;
-
- # parameter checking
- if (not defined $base_par) {
- croak "First argument to merge_par() must be the .par archive to modify.";
- }
-
- if (not -f $base_par or not -r _ or not -w _) {
- croak "'$base_par' is not a file or you do not have enough permissions to read and modify it.";
- }
-
- foreach (@additional_pars) {
- if (not -f $_ or not -r _) {
- croak "'$_' is not a file or you do not have enough permissions to read it.";
- }
- }
-
- # The unzipping will change directories. Remember old dir.
- my $old_cwd = Cwd::cwd();
-
- # Unzip the base par to a temp. dir.
- (undef, my $base_dir) = _unzip_to_tmpdir(
- dist => $base_par, subdir => 'blib'
- );
- my $blibdir = File::Spec->catdir($base_dir, 'blib');
-
- # move the META.yml to the (main) temp. dir.
- File::Copy::move(
- File::Spec->catfile($blibdir, 'META.yml'),
- File::Spec->catfile($base_dir, 'META.yml')
- );
- # delete (incorrect) MANIFEST
- unlink File::Spec->catfile($blibdir, 'MANIFEST');
-
- # extract additional pars and merge
- foreach my $par (@additional_pars) {
- # restore original directory because the par path
- # might have been relative!
- chdir($old_cwd);
- (undef, my $add_dir) = _unzip_to_tmpdir(
- dist => $par
- );
- my @files;
- my @dirs;
- # I hate File::Find
- # And I hate writing portable code, too.
- File::Find::find(
- {wanted =>sub {
- my $file = $File::Find::name;
- push @files, $file if -f $file;
- push @dirs, $file if -d _;
- }},
- $add_dir
- );
- my ($vol, $subdir, undef) = File::Spec->splitpath( $add_dir, 1);
- my @dir = File::Spec->splitdir( $subdir );
-
- # merge directory structure
- foreach my $dir (@dirs) {
- my ($v, $d, undef) = File::Spec->splitpath( $dir, 1 );
- my @d = File::Spec->splitdir( $d );
- shift @d foreach @dir; # remove tmp dir from path
- my $target = File::Spec->catdir( $blibdir, @d );
- mkdir($target);
- }
-
- # merge files
- foreach my $file (@files) {
- my ($v, $d, $f) = File::Spec->splitpath( $file );
- my @d = File::Spec->splitdir( $d );
- shift @d foreach @dir; # remove tmp dir from path
- my $target = File::Spec->catfile(
- File::Spec->catdir( $blibdir, @d ),
- $f
- );
- File::Copy::copy($file, $target)
- or die "Could not copy '$file' to '$target': $!";
-
- }
- chdir($old_cwd);
- File::Path::rmtree([$add_dir]);
- }
-
- # delete (copied) MANIFEST and META.yml
- unlink File::Spec->catfile($blibdir, 'MANIFEST');
- unlink File::Spec->catfile($blibdir, 'META.yml');
-
- chdir($base_dir);
- my $resulting_par_file = Cwd::abs_path(blib_to_par());
- chdir($old_cwd);
- File::Copy::move($resulting_par_file, $base_par);
-
- File::Path::rmtree([$base_dir]);
-}
-
-
-=head2 remove_man
-
-Remove the man pages from a PAR distribution. Takes one named
-parameter: I<dist> which should be the name (and path) of the
-PAR distribution file. The calling conventions outlined in
-the C<FUNCTIONS> section above apply.
-
-The PAR archive will be
-extracted, stripped of all C<man\d?> and C<html> subdirectories
-and then repackaged into the original file.
-
-=cut
-
-sub remove_man {
- my %args = &_args;
- my $par = $args{dist};
- require Cwd;
- require File::Copy;
- require File::Path;
- require File::Find;
-
- # parameter checking
- if (not defined $par) {
- croak "First argument to remove_man() must be the .par archive to modify.";
- }
-
- if (not -f $par or not -r _ or not -w _) {
- croak "'$par' is not a file or you do not have enough permissions to read and modify it.";
- }
-
- # The unzipping will change directories. Remember old dir.
- my $old_cwd = Cwd::cwd();
-
- # Unzip the base par to a temp. dir.
- (undef, my $base_dir) = _unzip_to_tmpdir(
- dist => $par, subdir => 'blib'
- );
- my $blibdir = File::Spec->catdir($base_dir, 'blib');
-
- # move the META.yml to the (main) temp. dir.
- File::Copy::move(
- File::Spec->catfile($blibdir, 'META.yml'),
- File::Spec->catfile($base_dir, 'META.yml')
- );
- # delete (incorrect) MANIFEST
- unlink File::Spec->catfile($blibdir, 'MANIFEST');
-
- opendir DIRECTORY, 'blib' or die $!;
- my @dirs = grep { /^blib\/(?:man\d*|html)$/ }
- grep { -d $_ }
- map { File::Spec->catfile('blib', $_) }
- readdir DIRECTORY;
- close DIRECTORY;
-
- File::Path::rmtree(\@dirs);
-
- chdir($base_dir);
- my $resulting_par_file = Cwd::abs_path(blib_to_par());
- chdir($old_cwd);
- File::Copy::move($resulting_par_file, $par);
-
- File::Path::rmtree([$base_dir]);
-}
-
-
-=head2 get_meta
-
-Opens a PAR archive and extracts the contained META.yml file.
-Returns the META.yml file as a string.
-
-Takes one named parameter: I<dist>. If only one parameter is
-passed, it is treated as the I<dist> parameter. (Have a look
-at the description in the C<FUNCTIONS> section above.)
-
-Returns undef if no PAR archive or no META.yml within the
-archive were found.
-
-=cut
-
-sub get_meta {
- my %args = &_args;
- my $dist = $args{dist};
- return undef if not defined $dist or not -r $dist;
- require Cwd;
- require File::Path;
-
- # The unzipping will change directories. Remember old dir.
- my $old_cwd = Cwd::cwd();
-
- # Unzip the base par to a temp. dir.
- (undef, my $base_dir) = _unzip_to_tmpdir(
- dist => $dist, subdir => 'blib'
- );
- my $blibdir = File::Spec->catdir($base_dir, 'blib');
-
- my $meta = File::Spec->catfile($blibdir, 'META.yml');
-
- if (not -r $meta) {
- return undef;
- }
-
- open FH, '<', $meta
- or die "Could not open file '$meta' for reading: $!";
-
- local $/ = undef;
- my $meta_text = <FH>;
- close FH;
-
- chdir($old_cwd);
-
- File::Path::rmtree([$base_dir]);
-
- return $meta_text;
-}
-
-
-
-sub _unzip {
- my %args = &_args;
- my $dist = $args{dist};
- my $path = $args{path} || File::Spec->curdir;
- return unless -f $dist;
-
- # Try fast unzipping first
- if (eval { require Archive::Unzip::Burst; 1 }) {
- my $return = Archive::Unzip::Burst::unzip($dist, $path);
- return if $return; # true return value == error (a la system call)
- }
- # Then slow unzipping
- if (eval { require Archive::Zip; 1 }) {
- my $zip = Archive::Zip->new;
- local %SIG;
- $SIG{__WARN__} = sub { print STDERR $_[0] unless $_[0] =~ /\bstat\b/ };
- return unless $zip->read($dist) == Archive::Zip::AZ_OK()
- and $zip->extractTree('', "$path/") == Archive::Zip::AZ_OK();
- }
- # Then fall back to the system
- else {
- return if system(unzip => $dist, '-d', $path);
- }
-
- return 1;
-}
-
-sub _zip {
- my %args = &_args;
- my $dist = $args{dist};
-
- if (eval { require Archive::Zip; 1 }) {
- my $zip = Archive::Zip->new;
- $zip->addTree( File::Spec->curdir, '' );
- $zip->writeToFileNamed( $dist ) == Archive::Zip::AZ_OK() or die $!;
- }
- else {
- system(qw(zip -r), $dist, File::Spec->curdir) and die $!;
- }
-}
-
-
-# This sub munges the arguments to most of the PAR::Dist functions
-# into a hash. On the way, it downloads PAR archives as necessary, etc.
-sub _args {
- # default to the first .par in the CWD
- if (not @_) {
- @_ = (glob('*.par'))[0];
- }
-
- # single argument => it's a distribution file name or URL
- @_ = (dist => @_) if @_ == 1;
-
- my %args = @_;
- $args{name} ||= $args{dist};
-
- # If we are installing from an URL, we want to munge the
- # distribution name so that it is in form "Module-Name"
- if (defined $args{name}) {
- $args{name} =~ s/^\w+:\/\///;
- my @elems = parse_dist_name($args{name});
- # @elems is name, version, arch, perlversion
- if (defined $elems[0]) {
- $args{name} = $elems[0];
- }
- else {
- $args{name} =~ s/^.*\/([^\/]+)$/$1/;
- $args{name} =~ s/^([0-9A-Za-z_-]+)-\d+\..+$/$1/;
- }
- }
-
- # append suffix if there is none
- if ($args{dist} and not $args{dist} =~ /\.[a-zA-Z_][^.]*$/) {
- require Config;
- my $suffix = $args{suffix};
- $suffix ||= "$Config::Config{archname}-$Config::Config{version}.par";
- $args{dist} .= "-$suffix";
- }
-
- # download if it's an URL
- if ($args{dist} and $args{dist} =~ m!^\w+://!) {
- $args{dist} = _fetch(dist => $args{dist})
- }
-
- return %args;
-}
-
-
-# Download PAR archive, but only if necessary (mirror!)
-my %escapes;
-sub _fetch {
- my %args = @_;
-
- if ($args{dist} =~ s/^file:\/\///) {
- return $args{dist} if -e $args{dist};
- return;
- }
- require LWP::Simple;
-
- $ENV{PAR_TEMP} ||= File::Spec->catdir(File::Spec->tmpdir, 'par');
- mkdir $ENV{PAR_TEMP}, 0777;
- %escapes = map { chr($_) => sprintf("%%%02X", $_) } 0..255 unless %escapes;
-
- $args{dist} =~ s{^cpan://((([a-zA-Z])[a-zA-Z])[-_a-zA-Z]+)/}
- {http://www.cpan.org/modules/by-authors/id/\U$3/$2/$1\E/};
-
- my $file = $args{dist};
- $file =~ s/([^\w\.])/$escapes{$1}/g;
- $file = File::Spec->catfile( $ENV{PAR_TEMP}, $file);
- my $rc = LWP::Simple::mirror( $args{dist}, $file );
-
- if (!LWP::Simple::is_success($rc) and $rc != 304) {
- die "Error $rc: ", LWP::Simple::status_message($rc), " ($args{dist})\n";
- }
-
- return $file if -e $file;
- return;
-}
-
-sub _verify_or_sign {
- my %args = &_args;
-
- require File::Path;
- require Module::Signature;
- die "Module::Signature version 0.25 required"
- unless Module::Signature->VERSION >= 0.25;
-
- require Cwd;
- my $cwd = Cwd::cwd();
- my $action = $args{action};
- my ($dist, $tmpdir) = _unzip_to_tmpdir($args{dist});
- $action ||= (-e 'SIGNATURE' ? 'verify' : 'sign');
-
- if ($action eq 'sign') {
- open FH, '>SIGNATURE' unless -e 'SIGNATURE';
- open FH, 'MANIFEST' or die $!;
-
- local $/;
- my $out = <FH>;
- if ($out !~ /^SIGNATURE(?:\s|$)/m) {
- $out =~ s/^(?!\s)/SIGNATURE\n/m;
- open FH, '>MANIFEST' or die $!;
- print FH $out;
- }
- close FH;
-
- $args{overwrite} = 1 unless exists $args{overwrite};
- $args{skip} = 0 unless exists $args{skip};
- }
-
- my $rv = Module::Signature->can($action)->(%args);
- _zip(dist => $dist) if $action eq 'sign';
- File::Path::rmtree([$tmpdir]);
-
- chdir($cwd);
- return $rv;
-}
-
-sub _unzip_to_tmpdir {
- my %args = &_args;
-
- require File::Temp;
-
- my $dist = File::Spec->rel2abs($args{dist});
- my $tmpdirname = File::Spec->catdir(File::Spec->tmpdir, "parXXXXX");
- my $tmpdir = File::Temp::mkdtemp($tmpdirname)
- or die "Could not create temporary directory from template '$tmpdirname': $!";
- my $path = $tmpdir;
- $path = File::Spec->catdir($tmpdir, $args{subdir}) if defined $args{subdir};
- _unzip(dist => $dist, path => $path);
-
- chdir $tmpdir;
- return ($dist, $tmpdir);
-}
-
-
-
-=head2 parse_dist_name
-
-First argument must be a distribution file name. The file name
-is parsed into I<distribution name>, I<distribution version>,
-I<architecture name>, and I<perl version>.
-
-Returns the results as a list in the above order.
-If any or all of the above cannot be determined, returns undef instead
-of the undetermined elements.
-
-Supported formats are:
-
-Math-Symbolic-0.502-x86_64-linux-gnu-thread-multi-5.8.7
-
-Math-Symbolic-0.502
-
-The ".tar.gz" or ".par" extensions as well as any
-preceding paths are stripped before parsing. Starting with C<PAR::Dist>
-0.22, versions containing a preceding C<v> are parsed correctly.
-
-This function is not exported by default.
-
-=cut
-
-sub parse_dist_name {
- my $file = shift;
- return(undef, undef, undef, undef) if not defined $file;
-
- (undef, undef, $file) = File::Spec->splitpath($file);
-
- my $version = qr/v?(?:\d+(?:_\d+)?|\d*(?:\.\d+(?:_\d+)?)+)/;
- $file =~ s/\.(?:par|tar\.gz|tar)$//i;
- my @elem = split /-/, $file;
- my (@dn, $dv, @arch, $pv);
- while (@elem) {
- my $e = shift @elem;
- if (
- $e =~ /^$version$/o
- and not(# if not next token also a version
- # (assumes an arch string doesnt start with a version...)
- @elem and $elem[0] =~ /^$version$/o
- )
- ) {
-
- $dv = $e;
- last;
- }
- push @dn, $e;
- }
-
- my $dn;
- $dn = join('-', @dn) if @dn;
-
- if (not @elem) {
- return( $dn, $dv, undef, undef);
- }
-
- while (@elem) {
- my $e = shift @elem;
- if ($e =~ /^$version|any_version$/) {
- $pv = $e;
- last;
- }
- push @arch, $e;
- }
-
- my $arch;
- $arch = join('-', @arch) if @arch;
-
- return($dn, $dv, $arch, $pv);
-}
-
-=head2 generate_blib_stub
-
-Creates a F<blib/lib> subdirectory in the current directory
-and prepares a F<META.yml> with meta information for a
-new PAR distribution. First argument should be the name of the
-PAR distribution in a format understood by C<parse_dist_name()>.
-Alternatively, named arguments resembling those of
-C<blib_to_par> are accepted.
-
-After running C<generate_blib_stub> and injecting files into
-the F<blib> directory, you can create a PAR distribution
-using C<blib_to_par>.
-This function is useful for creating custom PAR distributions
-from scratch. (I.e. not from an unpacked CPAN distribution)
-Example:
-
- use PAR::Dist;
- use File::Copy 'copy';
-
- generate_blib_stub(
- name => 'MyApp', version => '1.00'
- );
- copy('MyApp.pm', 'blib/lib/MyApp.pm');
- blib_to_par(); # generates the .par file!
-
-C<generate_blib_stub> will not overwrite existing files.
-
-=cut
-
-sub generate_blib_stub {
- my %args = &_args;
- my $dist = $args{dist};
- require Config;
-
- my $name = $args{name};
- my $version = $args{version};
- my $suffix = $args{suffix};
-
- my ($parse_name, $parse_version, $archname, $perlversion)
- = parse_dist_name($dist);
-
- $name ||= $parse_name;
- $version ||= $parse_version;
- $suffix = "$archname-$perlversion"
- if (not defined $suffix or $suffix eq '')
- and $archname and $perlversion;
-
- $suffix ||= "$Config::Config{archname}-$Config::Config{version}";
- if ( grep { not defined $_ } ($name, $version, $suffix) ) {
- warn "Could not determine distribution meta information from distribution name '$dist'";
- return();
- }
- $suffix =~ s/\.par$//;
-
- if (not -f 'META.yml') {
- open META, '>', 'META.yml'
- or die "Could not open META.yml file for writing: $!";
- print META << "YAML" if fileno(META);
-name: $name
-version: $version
-build_requires: {}
-conflicts: {}
-dist_name: $name-$version-$suffix.par
-distribution_type: par
-dynamic_config: 0
-generated_by: 'PAR::Dist version $PAR::Dist::VERSION'
-license: unknown
-YAML
- close META;
- }
-
- mkdir('blib');
- mkdir(File::Spec->catdir('blib', 'lib'));
- mkdir(File::Spec->catdir('blib', 'script'));
-
- return 1;
-}
-
-
-=head2 contains_binaries
-
-This function is not exported by default.
-
-Opens a PAR archive tries to determine whether that archive
-contains platform-specific binary code.
-
-Takes one named parameter: I<dist>. If only one parameter is
-passed, it is treated as the I<dist> parameter. (Have a look
-at the description in the C<FUNCTIONS> section above.)
-
-Throws a fatal error if the PAR archive could not be found.
-
-Returns one if the PAR was found to contain binary code
-and zero otherwise.
-
-=cut
-
-sub contains_binaries {
- require File::Find;
- my %args = &_args;
- my $dist = $args{dist};
- return undef if not defined $dist or not -r $dist;
- require Cwd;
- require File::Path;
-
- # The unzipping will change directories. Remember old dir.
- my $old_cwd = Cwd::cwd();
-
- # Unzip the base par to a temp. dir.
- (undef, my $base_dir) = _unzip_to_tmpdir(
- dist => $dist, subdir => 'blib'
- );
- my $blibdir = File::Spec->catdir($base_dir, 'blib');
- my $archdir = File::Spec->catdir($blibdir, 'arch');
-
- my $found = 0;
-
- File::Find::find(
- sub {
- $found++ if -f $_ and not /^\.exists$/;
- },
- $archdir
- );
-
- chdir($old_cwd);
-
- File::Path::rmtree([$base_dir]);
-
- return $found ? 1 : 0;
-}
-
-1;
-
-=head1 SEE ALSO
-
-L<PAR>, L<ExtUtils::Install>, L<Module::Signature>, L<LWP::Simple>
-
-=head1 AUTHORS
-
-Audrey Tang E<lt>cpan@audreyt.orgE<gt> 2003-2007
-
-Steffen Mueller E<lt>smueller@cpan.orgE<gt> 2005-2007
-
-PAR has a mailing list, E<lt>par@perl.orgE<gt>, that you can write to;
-send an empty mail to E<lt>par-subscribe@perl.orgE<gt> to join the list
-and participate in the discussion.
-
-Please send bug reports to E<lt>bug-par@rt.cpan.orgE<gt>.
-
-=head1 COPYRIGHT
-
-Copyright 2003-2007 by Audrey 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/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Pod/Coverage.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Pod/Coverage.pm
deleted file mode 100644
index 64b7ae38080..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Pod/Coverage.pm
+++ /dev/null
@@ -1,486 +0,0 @@
-use strict;
-
-package Pod::Coverage;
-use Devel::Symdump;
-use B;
-use Pod::Find qw(pod_where);
-
-BEGIN { defined &TRACE_ALL or eval 'sub TRACE_ALL () { 0 }' }
-
-use vars qw/ $VERSION /;
-$VERSION = '0.19';
-
-=head1 NAME
-
-Pod::Coverage - Checks if the documentation of a module is comprehensive
-
-=head1 SYNOPSIS
-
- # in the beginnning...
- perl -MPod::Coverage=Pod::Coverage -e666
-
- # all in one invocation
- use Pod::Coverage package => 'Fishy';
-
- # straight OO
- use Pod::Coverage;
- my $pc = Pod::Coverage->new(package => 'Pod::Coverage');
- print "We rock!" if $pc->coverage == 1;
-
-
-=head1 DESCRIPTION
-
-Developers hate writing documentation. They'd hate it even more if
-their computer tattled on them, but maybe they'll be even more
-thankful in the long run. Even if not, F<perlmodstyle> tells you to, so
-you must obey.
-
-This module provides a mechanism for determining if the pod for a
-given module is comprehensive.
-
-It expects to find either a C<< =head(n>1) >> or an C<=item> block documenting a
-subroutine.
-
-Consider:
- # an imaginary Foo.pm
- package Foo;
-
- =item foo
-
- The foo sub
-
- = cut
-
- sub foo {}
- sub bar {}
-
- 1;
- __END__
-
-In this example C<Foo::foo> is covered, but C<Foo::bar> is not, so the C<Foo>
-package is only 50% (0.5) covered
-
-=head2 Methods
-
-=over
-
-=item Pod::Coverage->new(package => $package)
-
-Creates a new Pod::Coverage object.
-
-C<package> the name of the package to analyse
-
-C<private> an array of regexen which define what symbols are regarded
-as private (and so need not be documented) defaults to [ qr/^_/,
-qr/^import$/, qr/^DESTROY$/, qr/^AUTOLOAD$/, qr/^bootstrap$/,
- qr/^(TIE( SCALAR | ARRAY | HASH | HANDLE ) |
- FETCH | STORE | UNTIE | FETCHSIZE | STORESIZE |
- POP | PUSH | SHIFT | UNSHIFT | SPLICE | DELETE |
- EXISTS | EXTEND | CLEAR | FIRSTKEY | NEXTKEY | PRINT | PRINTF |
- WRITE | READLINE | GETC | READ | CLOSE | BINMODE | OPEN |
- EOF | FILENO | SEEK | TELL)$/x,
- qr/^( MODIFY | FETCH )_( REF | SCALAR | ARRAY | HASH | CODE |
- GLOB | FORMAT | IO)_ATTRIBUTES$/x,
- qr/^CLONE(_SKIP)?$/,
-]
-
-This should cover all the usual magical methods for tie()d objects,
-attributes, generally all the methods that are typically not called by
-a user, but instead being used internally by perl.
-
-C<also_private> items are appended to the private list
-
-C<trustme> an array of regexen which define what symbols you just want
-us to assume are properly documented even if we can't find any docs
-for them
-
-If C<pod_from> is supplied, that file is parsed for the documentation,
-rather than using Pod::Find
-
-If C<nonwhitespace> is supplied, then only POD sections which have
-non-whitespace characters will count towards being documented.
-
-=cut
-
-sub new {
- my $referent = shift;
- my %args = @_;
- my $class = ref $referent || $referent;
-
- my $private = $args{private} || [
- qr/^_/,
- qr/^import$/,
- qr/^DESTROY$/,
- qr/^AUTOLOAD$/,
- qr/^bootstrap$/,
- qr/^\(/,
- qr/^(TIE( SCALAR | ARRAY | HASH | HANDLE ) |
- FETCH | STORE | UNTIE | FETCHSIZE | STORESIZE |
- POP | PUSH | SHIFT | UNSHIFT | SPLICE | DELETE |
- EXISTS | EXTEND | CLEAR | FIRSTKEY | NEXTKEY | PRINT | PRINTF |
- WRITE | READLINE | GETC | READ | CLOSE | BINMODE | OPEN |
- EOF | FILENO | SEEK | TELL)$/x,
- qr/^( MODIFY | FETCH )_( REF | SCALAR | ARRAY | HASH | CODE |
- GLOB | FORMAT | IO)_ATTRIBUTES $/x,
- qr/^CLONE(_SKIP)?$/,
- ];
- push @$private, @{ $args{also_private} || [] };
- my $trustme = $args{trustme} || [];
- my $nonwhitespace = $args{nonwhitespace} || undef;
-
- my $self = bless {
- @_,
- private => $private,
- trustme => $trustme,
- nonwhitespace => $nonwhitespace
- }, $class;
-}
-
-=item $object->coverage
-
-Gives the coverage as a value in the range 0 to 1
-
-=cut
-
-sub coverage {
- my $self = shift;
-
- my $package = $self->{package};
- my $pods = $self->_get_pods;
- return unless $pods;
-
- my %symbols = map { $_ => 0 } $self->_get_syms($package);
-
- print "tying shoelaces\n" if TRACE_ALL;
- for my $pod (@$pods) {
- $symbols{$pod} = 1 if exists $symbols{$pod};
- }
-
- foreach my $sym ( keys %symbols ) {
- $symbols{$sym} = 1 if $self->_trustme_check($sym);
- }
-
- # stash the results for later
- $self->{symbols} = \%symbols;
-
- if (TRACE_ALL) {
- require Data::Dumper;
- print Data::Dumper::Dumper($self);
- }
-
- my $symbols = scalar keys %symbols;
- my $documented = scalar grep {$_} values %symbols;
- unless ($symbols) {
- $self->{why_unrated} = "no public symbols defined";
- return;
- }
- return $documented / $symbols;
-}
-
-=item $object->why_unrated
-
-C<< $object->coverage >> may return C<undef>, to indicate that it was
-unable to deduce coverage for a package. If this happens you should
-be able to check C<why_unrated> to get a useful excuse.
-
-=cut
-
-sub why_unrated {
- my $self = shift;
- $self->{why_unrated};
-}
-
-=item $object->naked/$object->uncovered
-
-Returns a list of uncovered routines, will implicitly call coverage if
-it's not already been called.
-
-Note, private and 'trustme' identifiers will be skipped.
-
-=cut
-
-sub naked {
- my $self = shift;
- $self->{symbols} or $self->coverage;
- return unless $self->{symbols};
- return grep { !$self->{symbols}{$_} } keys %{ $self->{symbols} };
-}
-
-*uncovered = \&naked;
-
-=item $object->covered
-
-Returns a list of covered routines, will implicitly call coverage if
-it's not previously been called.
-
-As with C<naked>, private and 'trustme' identifiers will be skipped.
-
-=cut
-
-sub covered {
- my $self = shift;
- $self->{symbols} or $self->coverage;
- return unless $self->{symbols};
- return grep { $self->{symbols}{$_} } keys %{ $self->{symbols} };
-}
-
-sub import {
- my $self = shift;
- return unless @_;
-
- # one argument - just a package
- scalar @_ == 1 and unshift @_, 'package';
-
- # we were called with arguments
- my $pc = $self->new(@_);
- my $rating = $pc->coverage;
- $rating = 'unrated (' . $pc->why_unrated . ')'
- unless defined $rating;
- print $pc->{package}, " has a $self rating of $rating\n";
- my @looky_here = $pc->naked;
- if ( @looky_here > 1 ) {
- print "The following are uncovered: ", join( ", ", sort @looky_here ),
- "\n";
- } elsif (@looky_here) {
- print "'$looky_here[0]' is uncovered\n";
- }
-}
-
-=back
-
-=head2 Debugging support
-
-In order to allow internals debugging, while allowing the optimiser to
-do its thang, C<Pod::Coverage> uses constant subs to define how it traces.
-
-Use them like so
-
- sub Pod::Coverage::TRACE_ALL () { 1 }
- use Pod::Coverage;
-
-Supported constants are:
-
-=over
-
-=item TRACE_ALL
-
-Trace everything.
-
-Well that's all there is so far, are you glad you came?
-
-=back
-
-=head2 Inheritance interface
-
-These abstract methods while functional in C<Pod::Coverage> may make
-your life easier if you want to extend C<Pod::Coverage> to fit your
-house style more closely.
-
-B<NOTE> Please consider this interface as in a state of flux until
-this comment goes away.
-
-=over
-
-=item $object->_CvGV($symbol)
-
-Return the GV for the coderef supplied. Used by C<_get_syms> to identify
-locally defined code.
-
-You probably won't need to override this one.
-
-=item $object->_get_syms($package)
-
-return a list of symbols to check for from the specified packahe
-
-=cut
-
-# this one walks the symbol tree
-sub _get_syms {
- my $self = shift;
- my $package = shift;
-
- print "requiring '$package'\n" if TRACE_ALL;
- eval qq{ require $package };
- print "require failed with $@\n" if TRACE_ALL and $@;
- return if $@;
-
- print "walking symbols\n" if TRACE_ALL;
- my $syms = Devel::Symdump->new($package);
-
- my @symbols;
- for my $sym ( $syms->functions ) {
-
- # see if said method wasn't just imported from elsewhere
- my $glob = do { no strict 'refs'; \*{$sym} };
- my $o = B::svref_2object($glob);
-
- # in 5.005 this flag is not exposed via B, though it exists
- my $imported_cv = eval { B::GVf_IMPORTED_CV() } || 0x80;
- next if $o->GvFLAGS & $imported_cv;
-
- # check if it's on the whitelist
- $sym =~ s/$self->{package}:://;
- next if $self->_private_check($sym);
-
- push @symbols, $sym;
- }
- return @symbols;
-}
-
-=item _get_pods
-
-Extract pod markers from the currently active package.
-
-Return an arrayref or undef on fail.
-
-=cut
-
-sub _get_pods {
- my $self = shift;
-
- my $package = $self->{package};
-
- print "getting pod location for '$package'\n" if TRACE_ALL;
- $self->{pod_from} ||= pod_where( { -inc => 1 }, $package );
-
- my $pod_from = $self->{pod_from};
- unless ($pod_from) {
- $self->{why_unrated} = "couldn't find pod";
- return;
- }
-
- print "parsing '$pod_from'\n" if TRACE_ALL;
- my $pod = Pod::Coverage::Extractor->new;
- $pod->{nonwhitespace} = $self->{nonwhitespace};
- $pod->parse_from_file( $pod_from, '/dev/null' );
-
- return $pod->{identifiers} || [];
-}
-
-=item _private_check($symbol)
-
-return true if the symbol should be considered private
-
-=cut
-
-sub _private_check {
- my $self = shift;
- my $sym = shift;
- return grep { $sym =~ /$_/ } @{ $self->{private} };
-}
-
-=item _trustme_check($symbol)
-
-return true if the symbol is a 'trustme' symbol
-
-=cut
-
-sub _trustme_check {
- my ( $self, $sym ) = @_;
- return grep { $sym =~ /$_/ } @{ $self->{trustme} };
-}
-
-sub _CvGV {
- my $self = shift;
- my $cv = shift;
- my $b_cv = B::svref_2object($cv);
-
- # perl 5.6.2's B doesn't have an object_2svref. in 5.8 you can
- # just do this:
- # return *{ $b_cv->GV->object_2svref };
- # but for backcompat we're forced into this uglyness:
- no strict 'refs';
- return *{ $b_cv->GV->STASH->NAME . "::" . $b_cv->GV->NAME };
-}
-
-package Pod::Coverage::Extractor;
-use Pod::Parser;
-use base 'Pod::Parser';
-
-use constant debug => 0;
-
-# extract subnames from a pod stream
-sub command {
- my $self = shift;
- my ( $command, $text, $line_num ) = @_;
- if ( $command eq 'item' || $command =~ /^head(?:2|3|4)/ ) {
-
- # take a closer look
- my @pods = ( $text =~ /\s*([^\s\|,\/]+)/g );
- $self->{recent} = [];
-
- foreach my $pod (@pods) {
- print "Considering: '$pod'\n" if debug;
-
- # it's dressed up like a method cal
- $pod =~ /-E<\s*gt\s*>(.*)/ and $pod = $1;
- $pod =~ /->(.*)/ and $pod = $1;
-
- # it's used as a (bare) fully qualified name
- $pod =~ /\w+(?:::\w+)*::(\w+)/ and $pod = $1;
-
- # it's wrapped in a pod style B<>
- $pod =~ s/[A-Z]<//g;
- $pod =~ s/>//g;
-
- # has arguments, or a semicolon
- $pod =~ /(\w+)\s*[;\(]/ and $pod = $1;
-
- print "Adding: '$pod'\n" if debug;
- push @{ $self->{ $self->{nonwhitespace}
- ? "recent"
- : "identifiers" } }, $pod;
- }
- }
-}
-
-sub textblock {
- my $self = shift;
- my ( $text, $line_num ) = shift;
- if ( $self->{nonwhitespace} and $text =~ /\S/ and $self->{recent} ) {
- push @{ $self->{identifiers} }, @{ $self->{recent} };
- $self->{recent} = [];
- }
-}
-
-1;
-
-__END__
-
-=back
-
-=head1 BUGS
-
-Due to the method used to identify documented subroutines
-C<Pod::Coverage> may completely miss your house style and declare your
-code undocumented. Patches and/or failing tests welcome.
-
-=head1 TODO
-
-=over
-
-=item Widen the rules for identifying documentation
-
-=item Improve the code coverage of the test suite. C<Devel::Cover> rocks so hard.
-
-=back
-
-=head1 SEE ALSO
-
-L<Test::More>, L<Devel::Cover>
-
-=head1 AUTHORS
-
-Richard Clamp <richardc@unixbeard.net>
-
-Michael Stevens <mstevens@etla.org>
-
-some contributions from David Cantrell <david@cantrell.org.uk>
-
-=head1 COPYRIGHT
-
-Copyright (c) 2001, 2003, 2004, 2006, 2007 Richard Clamp, Michael
-Stevens. 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/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Pod/Coverage/CountParents.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Pod/Coverage/CountParents.pm
deleted file mode 100644
index 08931e79c3f..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Pod/Coverage/CountParents.pm
+++ /dev/null
@@ -1,77 +0,0 @@
-package Pod::Coverage::CountParents;
-use strict;
-use Pod::Coverage ();
-use base 'Pod::Coverage';
-
-# this code considered lightly fugly :)
-
-sub _get_pods {
- my $self = shift;
- my $package = $self->{package};
-
- eval qq{ require $package };
- if ($@) {
- $self->{why_unrated} = "Couldn't compile '$package' to inspect: $@";
- return;
- }
-
- my %pods;
- $pods{$package} = $self->SUPER::_get_pods;
-
- __walk_up($package, \%pods);
- my %flat = map { $_ => 1 } map { @{ $_ || [] } } values %pods;
- return [ keys %flat ];
-}
-
-sub __walk_up {
- my $package = shift;
- my $pods = shift;
-
- $pods->{$package} = Pod::Coverage->new(package => $package)->_get_pods();
-
- my @parents;
- {
- no strict 'refs';
- @parents = @{"$package\::ISA"};
- }
-
- do { $pods->{$_} || __walk_up($_, $pods) } for @parents;
-}
-
-1;
-__END__
-
-
-=head1 NAME
-
-Pod::Coverage::CountParents - subclass of Pod::Coverage that examines the inheritance tree
-
-=head1 SYNOPSIS
-
- # all in one invocation
- use Pod::Coverage::CountParents package => 'Fishy';
-
- # straight OO
- use Pod::Coverage::CountParents;
- my $pc = new Pod::Coverage::CountParents package => 'Pod::Coverage';
- print "We rock!" if $pc->coverage == 1;
-
-=head1 DESCRIPTION
-
-This module extends Pod::Coverage to include the documentation from
-parent classes when identifying the coverage of the code.
-
-If you want full documentation we suggest you check the
-L<Pod::Coverage> documentation.
-
-=head1 SEE ALSO
-
-L<Pod::Coverage>, L<base>
-
-=head1 AUTHOR
-
-Copyright (c) 2002 Richard Clamp. 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/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Pod/Coverage/ExportOnly.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Pod/Coverage/ExportOnly.pm
deleted file mode 100644
index df979b1d14b..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Pod/Coverage/ExportOnly.pm
+++ /dev/null
@@ -1,53 +0,0 @@
-package Pod::Coverage::ExportOnly;
-use strict;
-use Pod::Coverage ();
-use base qw(Pod::Coverage);
-
-sub _get_syms {
- my $self = shift;
- my $package = shift;
-
- # lifted from UNIVERSAL::exports
- no strict 'refs';
- my %exports = map { $_ => 1 } @{$package.'::EXPORT'},
- @{$package.'::EXPORT_OK'};
-
- return keys %exports;
-}
-
-1;
-__END__
-
-=head1 NAME
-
-Pod::Coverage::ExportOnly - subclass of Pod::Coverage than only examines exported functions
-
-=head1 SYNOPSIS
-
- # all in one invocation
- use Pod::Coverage::ExportOnly package => 'Fishy';
-
- # straight OO
- use Pod::Coverage::ExportOnly;
- my $pc = new Pod::Coverage::ExportOnly package => 'Pod::Coverage';
- print "We rock!" if $pc->coverage == 1;
-
-=head1 DESCRIPTION
-
-This module extends Pod::Coverage to only check things explicitly set
-up for export by the Exporter or UNIVERSAL::exports modules. If you
-want full documentation we suggest you check the L<Pod::Coverage>
-documentation
-
-=head1 SEE ALSO
-
-L<Pod::Coverage>, L<Exporter>, L<UNIVERSAL::exports>
-
-=head1 AUTHORS
-
-Copyright (c) 2001 Richard Clamp, Micheal Stevens. 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/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Pod/Coverage/Overloader.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Pod/Coverage/Overloader.pm
deleted file mode 100644
index fb09af8ac92..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Pod/Coverage/Overloader.pm
+++ /dev/null
@@ -1,37 +0,0 @@
-package Pod::Coverage::Overloader;
-use strict;
-use Pod::Coverage ();
-use base qw(Pod::Coverage);
-
-sub new {
- my $class = shift;
-
- warn "Pod::Coverage::Overloader is deprecated. Please use Pod::Coverage instead";
- $class->SUPER::new( @_ );
-}
-
-1;
-__END__
-
-=head1 NAME
-
-Pod::Coverage::Overloader - deprecated subclass of Pod::Coverage
-
-=head1 SYNOPSIS
-
- # Please do not use this module, it was an experiment that went
- # awry. Use Pod::Coverage instead
-
-=head1 DESCRIPTION
-
-=head1 SEE ALSO
-
-L<Pod::Coverage>, L<overload>
-
-=head1 AUTHORS
-
-Copyright (c) 2001 Richard Clamp, Micheal Stevens. 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/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Pod/Escapes.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Pod/Escapes.pm
deleted file mode 100644
index de4d75a7b83..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Pod/Escapes.pm
+++ /dev/null
@@ -1,721 +0,0 @@
-
-require 5;
-# The documentation is at the end.
-# Time-stamp: "2004-05-07 15:31:25 ADT"
-package Pod::Escapes;
-require Exporter;
-@ISA = ('Exporter');
-$VERSION = '1.04';
-@EXPORT_OK = qw(
- %Code2USASCII
- %Name2character
- %Name2character_number
- %Latin1Code_to_fallback
- %Latin1Char_to_fallback
- e2char
- e2charnum
-);
-%EXPORT_TAGS = ('ALL' => \@EXPORT_OK);
-
-#==========================================================================
-
-use strict;
-use vars qw(
- %Code2USASCII
- %Name2character
- %Name2character_number
- %Latin1Code_to_fallback
- %Latin1Char_to_fallback
- $FAR_CHAR
- $FAR_CHAR_NUMBER
- $NOT_ASCII
-);
-
-$FAR_CHAR = "?" unless defined $FAR_CHAR;
-$FAR_CHAR_NUMBER = ord($FAR_CHAR) unless defined $FAR_CHAR_NUMBER;
-
-$NOT_ASCII = 'A' ne chr(65) unless defined $NOT_ASCII;
-
-#--------------------------------------------------------------------------
-sub e2char {
- my $in = $_[0];
- return undef unless defined $in and length $in;
-
- # Convert to decimal:
- if($in =~ m/^(0[0-7]*)$/s ) {
- $in = oct $in;
- } elsif($in =~ m/^0?x([0-9a-fA-F]+)$/s ) {
- $in = hex $1;
- } # else it's decimal, or named
-
- if($NOT_ASCII) {
- # We're in bizarro world of not-ASCII!
- # Cope with US-ASCII codes, use fallbacks for Latin-1, or use FAR_CHAR.
- unless($in =~ m/^\d+$/s) {
- # It's a named character reference. Get its numeric Unicode value.
- $in = $Name2character{$in};
- return undef unless defined $in; # (if there's no such name)
- $in = ord $in; # (All ents must be one character long.)
- # ...So $in holds the char's US-ASCII numeric value, which we'll
- # now go get the local equivalent for.
- }
-
- # It's numeric, whether by origin or by mutation from a known name
- return $Code2USASCII{$in} # so "65" => "A" everywhere
- || $Latin1Code_to_fallback{$in} # Fallback.
- || $FAR_CHAR; # Fall further back
- }
-
- # Normal handling:
- if($in =~ m/^\d+$/s) {
- if($] < 5.007 and $in > 255) { # can't be trusted with Unicode
- return $FAR_CHAR;
- } else {
- return chr($in);
- }
- } else {
- return $Name2character{$in}; # returns undef if unknown
- }
-}
-
-#--------------------------------------------------------------------------
-sub e2charnum {
- my $in = $_[0];
- return undef unless defined $in and length $in;
-
- # Convert to decimal:
- if($in =~ m/^(0[0-7]*)$/s ) {
- $in = oct $in;
- } elsif($in =~ m/^0?x([0-9a-fA-F]+)$/s ) {
- $in = hex $1;
- } # else it's decimal, or named
-
- if($in =~ m/^\d+$/s) {
- return 0 + $in;
- } else {
- return $Name2character_number{$in}; # returns undef if unknown
- }
-}
-
-#--------------------------------------------------------------------------
-
-%Name2character_number = (
- # General XML/XHTML:
- 'lt' => 60,
- 'gt' => 62,
- 'quot' => 34,
- 'amp' => 38,
- 'apos' => 39,
-
- # POD-specific:
- 'sol' => 47,
- 'verbar' => 124,
-
- 'lchevron' => 171, # legacy for laquo
- 'rchevron' => 187, # legacy for raquo
-
- # Remember, grave looks like \ (as in virtu\)
- # acute looks like / (as in re/sume/)
- # circumflex looks like ^ (as in papier ma^che/)
- # umlaut/dieresis looks like " (as in nai"ve, Chloe")
-
- # From the XHTML 1 .ent files:
- 'nbsp' , 160,
- 'iexcl' , 161,
- 'cent' , 162,
- 'pound' , 163,
- 'curren' , 164,
- 'yen' , 165,
- 'brvbar' , 166,
- 'sect' , 167,
- 'uml' , 168,
- 'copy' , 169,
- 'ordf' , 170,
- 'laquo' , 171,
- 'not' , 172,
- 'shy' , 173,
- 'reg' , 174,
- 'macr' , 175,
- 'deg' , 176,
- 'plusmn' , 177,
- 'sup2' , 178,
- 'sup3' , 179,
- 'acute' , 180,
- 'micro' , 181,
- 'para' , 182,
- 'middot' , 183,
- 'cedil' , 184,
- 'sup1' , 185,
- 'ordm' , 186,
- 'raquo' , 187,
- 'frac14' , 188,
- 'frac12' , 189,
- 'frac34' , 190,
- 'iquest' , 191,
- 'Agrave' , 192,
- 'Aacute' , 193,
- 'Acirc' , 194,
- 'Atilde' , 195,
- 'Auml' , 196,
- 'Aring' , 197,
- 'AElig' , 198,
- 'Ccedil' , 199,
- 'Egrave' , 200,
- 'Eacute' , 201,
- 'Ecirc' , 202,
- 'Euml' , 203,
- 'Igrave' , 204,
- 'Iacute' , 205,
- 'Icirc' , 206,
- 'Iuml' , 207,
- 'ETH' , 208,
- 'Ntilde' , 209,
- 'Ograve' , 210,
- 'Oacute' , 211,
- 'Ocirc' , 212,
- 'Otilde' , 213,
- 'Ouml' , 214,
- 'times' , 215,
- 'Oslash' , 216,
- 'Ugrave' , 217,
- 'Uacute' , 218,
- 'Ucirc' , 219,
- 'Uuml' , 220,
- 'Yacute' , 221,
- 'THORN' , 222,
- 'szlig' , 223,
- 'agrave' , 224,
- 'aacute' , 225,
- 'acirc' , 226,
- 'atilde' , 227,
- 'auml' , 228,
- 'aring' , 229,
- 'aelig' , 230,
- 'ccedil' , 231,
- 'egrave' , 232,
- 'eacute' , 233,
- 'ecirc' , 234,
- 'euml' , 235,
- 'igrave' , 236,
- 'iacute' , 237,
- 'icirc' , 238,
- 'iuml' , 239,
- 'eth' , 240,
- 'ntilde' , 241,
- 'ograve' , 242,
- 'oacute' , 243,
- 'ocirc' , 244,
- 'otilde' , 245,
- 'ouml' , 246,
- 'divide' , 247,
- 'oslash' , 248,
- 'ugrave' , 249,
- 'uacute' , 250,
- 'ucirc' , 251,
- 'uuml' , 252,
- 'yacute' , 253,
- 'thorn' , 254,
- 'yuml' , 255,
-
- 'fnof' , 402,
- 'Alpha' , 913,
- 'Beta' , 914,
- 'Gamma' , 915,
- 'Delta' , 916,
- 'Epsilon' , 917,
- 'Zeta' , 918,
- 'Eta' , 919,
- 'Theta' , 920,
- 'Iota' , 921,
- 'Kappa' , 922,
- 'Lambda' , 923,
- 'Mu' , 924,
- 'Nu' , 925,
- 'Xi' , 926,
- 'Omicron' , 927,
- 'Pi' , 928,
- 'Rho' , 929,
- 'Sigma' , 931,
- 'Tau' , 932,
- 'Upsilon' , 933,
- 'Phi' , 934,
- 'Chi' , 935,
- 'Psi' , 936,
- 'Omega' , 937,
- 'alpha' , 945,
- 'beta' , 946,
- 'gamma' , 947,
- 'delta' , 948,
- 'epsilon' , 949,
- 'zeta' , 950,
- 'eta' , 951,
- 'theta' , 952,
- 'iota' , 953,
- 'kappa' , 954,
- 'lambda' , 955,
- 'mu' , 956,
- 'nu' , 957,
- 'xi' , 958,
- 'omicron' , 959,
- 'pi' , 960,
- 'rho' , 961,
- 'sigmaf' , 962,
- 'sigma' , 963,
- 'tau' , 964,
- 'upsilon' , 965,
- 'phi' , 966,
- 'chi' , 967,
- 'psi' , 968,
- 'omega' , 969,
- 'thetasym' , 977,
- 'upsih' , 978,
- 'piv' , 982,
- 'bull' , 8226,
- 'hellip' , 8230,
- 'prime' , 8242,
- 'Prime' , 8243,
- 'oline' , 8254,
- 'frasl' , 8260,
- 'weierp' , 8472,
- 'image' , 8465,
- 'real' , 8476,
- 'trade' , 8482,
- 'alefsym' , 8501,
- 'larr' , 8592,
- 'uarr' , 8593,
- 'rarr' , 8594,
- 'darr' , 8595,
- 'harr' , 8596,
- 'crarr' , 8629,
- 'lArr' , 8656,
- 'uArr' , 8657,
- 'rArr' , 8658,
- 'dArr' , 8659,
- 'hArr' , 8660,
- 'forall' , 8704,
- 'part' , 8706,
- 'exist' , 8707,
- 'empty' , 8709,
- 'nabla' , 8711,
- 'isin' , 8712,
- 'notin' , 8713,
- 'ni' , 8715,
- 'prod' , 8719,
- 'sum' , 8721,
- 'minus' , 8722,
- 'lowast' , 8727,
- 'radic' , 8730,
- 'prop' , 8733,
- 'infin' , 8734,
- 'ang' , 8736,
- 'and' , 8743,
- 'or' , 8744,
- 'cap' , 8745,
- 'cup' , 8746,
- 'int' , 8747,
- 'there4' , 8756,
- 'sim' , 8764,
- 'cong' , 8773,
- 'asymp' , 8776,
- 'ne' , 8800,
- 'equiv' , 8801,
- 'le' , 8804,
- 'ge' , 8805,
- 'sub' , 8834,
- 'sup' , 8835,
- 'nsub' , 8836,
- 'sube' , 8838,
- 'supe' , 8839,
- 'oplus' , 8853,
- 'otimes' , 8855,
- 'perp' , 8869,
- 'sdot' , 8901,
- 'lceil' , 8968,
- 'rceil' , 8969,
- 'lfloor' , 8970,
- 'rfloor' , 8971,
- 'lang' , 9001,
- 'rang' , 9002,
- 'loz' , 9674,
- 'spades' , 9824,
- 'clubs' , 9827,
- 'hearts' , 9829,
- 'diams' , 9830,
- 'OElig' , 338,
- 'oelig' , 339,
- 'Scaron' , 352,
- 'scaron' , 353,
- 'Yuml' , 376,
- 'circ' , 710,
- 'tilde' , 732,
- 'ensp' , 8194,
- 'emsp' , 8195,
- 'thinsp' , 8201,
- 'zwnj' , 8204,
- 'zwj' , 8205,
- 'lrm' , 8206,
- 'rlm' , 8207,
- 'ndash' , 8211,
- 'mdash' , 8212,
- 'lsquo' , 8216,
- 'rsquo' , 8217,
- 'sbquo' , 8218,
- 'ldquo' , 8220,
- 'rdquo' , 8221,
- 'bdquo' , 8222,
- 'dagger' , 8224,
- 'Dagger' , 8225,
- 'permil' , 8240,
- 'lsaquo' , 8249,
- 'rsaquo' , 8250,
- 'euro' , 8364,
-);
-
-
-# Fill out %Name2character...
-{
- %Name2character = ();
- my($name, $number);
- while( ($name, $number) = each %Name2character_number) {
- if($] < 5.007 and $number > 255) {
- $Name2character{$name} = $FAR_CHAR;
- # substitute for Unicode characters, for perls
- # that can't reliable handle them
- } else {
- $Name2character{$name} = chr $number;
- # normal case
- }
- }
- # So they resolve 'right' even in EBCDIC-land
- $Name2character{'lt' } = '<';
- $Name2character{'gt' } = '>';
- $Name2character{'quot'} = '"';
- $Name2character{'amp' } = '&';
- $Name2character{'apos'} = "'";
- $Name2character{'sol' } = '/';
- $Name2character{'verbar'} = '|';
-}
-
-#--------------------------------------------------------------------------
-
-%Code2USASCII = (
-# mostly generated by
-# perl -e "printf qq{ \x25 3s, '\x25s',\n}, $_, chr($_) foreach (32 .. 126)"
- 32, ' ',
- 33, '!',
- 34, '"',
- 35, '#',
- 36, '$',
- 37, '%',
- 38, '&',
- 39, "'", #!
- 40, '(',
- 41, ')',
- 42, '*',
- 43, '+',
- 44, ',',
- 45, '-',
- 46, '.',
- 47, '/',
- 48, '0',
- 49, '1',
- 50, '2',
- 51, '3',
- 52, '4',
- 53, '5',
- 54, '6',
- 55, '7',
- 56, '8',
- 57, '9',
- 58, ':',
- 59, ';',
- 60, '<',
- 61, '=',
- 62, '>',
- 63, '?',
- 64, '@',
- 65, 'A',
- 66, 'B',
- 67, 'C',
- 68, 'D',
- 69, 'E',
- 70, 'F',
- 71, 'G',
- 72, 'H',
- 73, 'I',
- 74, 'J',
- 75, 'K',
- 76, 'L',
- 77, 'M',
- 78, 'N',
- 79, 'O',
- 80, 'P',
- 81, 'Q',
- 82, 'R',
- 83, 'S',
- 84, 'T',
- 85, 'U',
- 86, 'V',
- 87, 'W',
- 88, 'X',
- 89, 'Y',
- 90, 'Z',
- 91, '[',
- 92, "\\", #!
- 93, ']',
- 94, '^',
- 95, '_',
- 96, '`',
- 97, 'a',
- 98, 'b',
- 99, 'c',
- 100, 'd',
- 101, 'e',
- 102, 'f',
- 103, 'g',
- 104, 'h',
- 105, 'i',
- 106, 'j',
- 107, 'k',
- 108, 'l',
- 109, 'm',
- 110, 'n',
- 111, 'o',
- 112, 'p',
- 113, 'q',
- 114, 'r',
- 115, 's',
- 116, 't',
- 117, 'u',
- 118, 'v',
- 119, 'w',
- 120, 'x',
- 121, 'y',
- 122, 'z',
- 123, '{',
- 124, '|',
- 125, '}',
- 126, '~',
-);
-
-#--------------------------------------------------------------------------
-
-%Latin1Code_to_fallback = ();
-@Latin1Code_to_fallback{0xA0 .. 0xFF} = (
-# Copied from Text/Unidecode/x00.pm:
-
-' ', qq{!}, qq{C/}, 'PS', qq{\$?}, qq{Y=}, qq{|}, 'SS', qq{"}, qq{(c)}, 'a', qq{<<}, qq{!}, "", qq{(r)}, qq{-},
-'deg', qq{+-}, '2', '3', qq{'}, 'u', 'P', qq{*}, qq{,}, '1', 'o', qq{>>}, qq{1/4}, qq{1/2}, qq{3/4}, qq{?},
-'A', 'A', 'A', 'A', 'A', 'A', 'AE', 'C', 'E', 'E', 'E', 'E', 'I', 'I', 'I', 'I',
-'D', 'N', 'O', 'O', 'O', 'O', 'O', 'x', 'O', 'U', 'U', 'U', 'U', 'U', 'Th', 'ss',
-'a', 'a', 'a', 'a', 'a', 'a', 'ae', 'c', 'e', 'e', 'e', 'e', 'i', 'i', 'i', 'i',
-'d', 'n', 'o', 'o', 'o', 'o', 'o', qq{/}, 'o', 'u', 'u', 'u', 'u', 'y', 'th', 'y',
-
-);
-
-{
- # Now stuff %Latin1Char_to_fallback:
- %Latin1Char_to_fallback = ();
- my($k,$v);
- while( ($k,$v) = each %Latin1Code_to_fallback) {
- $Latin1Char_to_fallback{chr $k} = $v;
- #print chr($k), ' => ', $v, "\n";
- }
-}
-
-#--------------------------------------------------------------------------
-1;
-__END__
-
-=head1 NAME
-
-Pod::Escapes -- for resolving Pod EE<lt>...E<gt> sequences
-
-=head1 SYNOPSIS
-
- use Pod::Escapes qw(e2char);
- ...la la la, parsing POD, la la la...
- $text = e2char($e_node->label);
- unless(defined $text) {
- print "Unknown E sequence \"", $e_node->label, "\"!";
- }
- ...else print/interpolate $text...
-
-=head1 DESCRIPTION
-
-This module provides things that are useful in decoding
-Pod EE<lt>...E<gt> sequences. Presumably, it should be used
-only by Pod parsers and/or formatters.
-
-By default, Pod::Escapes exports none of its symbols. But
-you can request any of them to be exported.
-Either request them individually, as with
-C<use Pod::Escapes qw(symbolname symbolname2...);>,
-or you can do C<use Pod::Escapes qw(:ALL);> to get all
-exportable symbols.
-
-=head1 GOODIES
-
-=over
-
-=item e2char($e_content)
-
-Given a name or number that could appear in a
-C<EE<lt>name_or_numE<gt>> sequence, this returns the string that
-it stands for. For example, C<e2char('sol')>, C<e2char('47')>,
-C<e2char('0x2F')>, and C<e2char('057')> all return "/",
-because C<EE<lt>solE<gt>>, C<EE<lt>47E<gt>>, C<EE<lt>0x2fE<gt>>,
-and C<EE<lt>057E<gt>>, all mean "/". If
-the name has no known value (as with a name of "qacute") or is
-syntactally invalid (as with a name of "1/4"), this returns undef.
-
-=item e2charnum($e_content)
-
-Given a name or number that could appear in a
-C<EE<lt>name_or_numE<gt>> sequence, this returns the number of
-the Unicode character that this stands for. For example,
-C<e2char('sol')>, C<e2char('47')>,
-C<e2char('0x2F')>, and C<e2char('057')> all return 47,
-because C<EE<lt>solE<gt>>, C<EE<lt>47E<gt>>, C<EE<lt>0x2fE<gt>>,
-and C<EE<lt>057E<gt>>, all mean "/", whose Unicode number is 47. If
-the name has no known value (as with a name of "qacute") or is
-syntactally invalid (as with a name of "1/4"), this returns undef.
-
-=item $Name2character{I<name>}
-
-Maps from names (as in C<EE<lt>I<name>E<gt>>) like "eacute" or "sol"
-to the string that each stands for. Note that this does not
-include numerics (like "64" or "x981c"). Under old Perl versions
-(before 5.7) you get a "?" in place of characters whose Unicode
-value is over 255.
-
-=item $Name2character_number{I<name>}
-
-Maps from names (as in C<EE<lt>I<name>E<gt>>) like "eacute" or "sol"
-to the Unicode value that each stands for. For example,
-C<$Name2character_number{'eacute'}> is 201, and
-C<$Name2character_number{'eacute'}> is 8364. You get the correct
-Unicode value, regardless of the version of Perl you're using --
-which differs from C<%Name2character>'s behavior under pre-5.7 Perls.
-
-Note that this hash does not
-include numerics (like "64" or "x981c").
-
-=item $Latin1Code_to_fallback{I<integer>}
-
-For numbers in the range 160 (0x00A0) to 255 (0x00FF), this maps
-from the character code for a Latin-1 character (like 233 for
-lowercase e-acute) to the US-ASCII character that best aproximates
-it (like "e"). You may find this useful if you are rendering
-POD in a format that you think deals well only with US-ASCII
-characters.
-
-=item $Latin1Char_to_fallback{I<character>}
-
-Just as above, but maps from characters (like "\xE9",
-lowercase e-acute) to characters (like "e").
-
-=item $Code2USASCII{I<integer>}
-
-This maps from US-ASCII codes (like 32) to the corresponding
-character (like space, for 32). Only characters 32 to 126 are
-defined. This is meant for use by C<e2char($x)> when it senses
-that it's running on a non-ASCII platform (where chr(32) doesn't
-get you a space -- but $Code2USASCII{32} will). It's
-documented here just in case you might find it useful.
-
-=back
-
-=head1 CAVEATS
-
-On Perl versions before 5.7, Unicode characters with a value
-over 255 (like lambda or emdash) can't be conveyed. This
-module does work under such early Perl versions, but in the
-place of each such character, you get a "?". Latin-1
-characters (characters 160-255) are unaffected.
-
-Under EBCDIC platforms, C<e2char($n)> may not always be the
-same as C<chr(e2charnum($n))>, and ditto for
-C<$Name2character{$name}> and
-C<chr($Name2character_number{$name})>.
-
-=head1 SEE ALSO
-
-L<perlpod|perlpod>
-
-L<perlpodspec|perlpodspec>
-
-L<Text::Unidecode|Text::Unidecode>
-
-=head1 COPYRIGHT AND DISCLAIMERS
-
-Copyright (c) 2001-2004 Sean M. Burke. All rights reserved.
-
-This library 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.
-
-Portions of the data tables in this module are derived from the
-entity declarations in the W3C XHTML specification.
-
-Currently (October 2001), that's these three:
-
- http://www.w3.org/TR/xhtml1/DTD/xhtml-lat1.ent
- http://www.w3.org/TR/xhtml1/DTD/xhtml-special.ent
- http://www.w3.org/TR/xhtml1/DTD/xhtml-symbol.ent
-
-=head1 AUTHOR
-
-Sean M. Burke C<sburke@cpan.org>
-
-=cut
-
-#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-# What I used for reading the XHTML .ent files:
-
-use strict;
-my(@norms, @good, @bad);
-my $dir = 'c:/sgml/docbook/';
-my %escapes;
-foreach my $file (qw(
- xhtml-symbol.ent
- xhtml-lat1.ent
- xhtml-special.ent
-)) {
- open(IN, "<$dir$file") or die "can't read-open $dir$file: $!";
- print "Reading $file...\n";
- while(<IN>) {
- if(m/<!ENTITY\s+(\S+)\s+"&#([^;]+);">/) {
- my($name, $value) = ($1,$2);
- next if $name eq 'quot' or $name eq 'apos' or $name eq 'gt';
-
- $value = hex $1 if $value =~ m/^x([a-fA-F0-9]+)$/s;
- print "ILLEGAL VALUE $value" unless $value =~ m/^\d+$/s;
- if($value > 255) {
- push @good , sprintf " %-10s , chr(%s),\n", "'$name'", $value;
- push @bad , sprintf " %-10s , \$bad,\n", "'$name'", $value;
- } else {
- push @norms, sprintf " %-10s , chr(%s),\n", "'$name'", $value;
- }
- } elsif(m/<!ENT/) {
- print "# Skipping $_";
- }
-
- }
- close(IN);
-}
-
-print @norms;
-print "\n ( \$] .= 5.006001 ? (\n";
-print @good;
-print " ) : (\n";
-print @bad;
-print " )\n);\n";
-
-__END__
-#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Pod/Simple.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Pod/Simple.pm
deleted file mode 100644
index 6beacaa1c80..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Pod/Simple.pm
+++ /dev/null
@@ -1,1520 +0,0 @@
-
-require 5;
-package Pod::Simple;
-use strict;
-use Carp ();
-BEGIN { *DEBUG = sub () {0} unless defined &DEBUG }
-use integer;
-use Pod::Escapes 1.03 ();
-use Pod::Simple::LinkSection ();
-use Pod::Simple::BlackBox ();
-#use utf8;
-
-use vars qw(
- $VERSION @ISA
- @Known_formatting_codes @Known_directives
- %Known_formatting_codes %Known_directives
- $NL
-);
-
-@ISA = ('Pod::Simple::BlackBox');
-$VERSION = '3.05';
-
-@Known_formatting_codes = qw(I B C L E F S X Z);
-%Known_formatting_codes = map(($_=>1), @Known_formatting_codes);
-@Known_directives = qw(head1 head2 head3 head4 item over back);
-%Known_directives = map(($_=>'Plain'), @Known_directives);
-$NL = $/ unless defined $NL;
-
-#-----------------------------------------------------------------------------
-# Set up some constants:
-
-BEGIN {
- if(defined &ASCII) { }
- elsif(chr(65) eq 'A') { *ASCII = sub () {1} }
- else { *ASCII = sub () {''} }
-
- unless(defined &MANY_LINES) { *MANY_LINES = sub () {20} }
- DEBUG > 4 and print "MANY_LINES is ", MANY_LINES(), "\n";
- unless(MANY_LINES() >= 1) {
- die "MANY_LINES is too small (", MANY_LINES(), ")!\nAborting";
- }
- if(defined &UNICODE) { }
- elsif($] >= 5.008) { *UNICODE = sub() {1} }
- else { *UNICODE = sub() {''} }
-}
-if(DEBUG > 2) {
- print "# We are ", ASCII ? '' : 'not ', "in ASCII-land\n";
- print "# We are under a Unicode-safe Perl.\n";
-}
-
-# Design note:
-# This is a parser for Pod. It is not a parser for the set of Pod-like
-# languages which happens to contain Pod -- it is just for Pod, plus possibly
-# some extensions.
-
-# @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @
-#@ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @
-#@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
-
-__PACKAGE__->_accessorize(
- 'nbsp_for_S', # Whether to map S<...>'s to \xA0 characters
- 'source_filename', # Filename of the source, for use in warnings
- 'source_dead', # Whether to consider this parser's source dead
-
- 'output_fh', # The filehandle we're writing to, if applicable.
- # Used only in some derived classes.
-
- 'hide_line_numbers', # For some dumping subclasses: whether to pointedly
- # suppress the start_line attribute
-
- 'line_count', # the current line number
- 'pod_para_count', # count of pod paragraphs seen so far
-
- 'no_whining', # whether to suppress whining
- 'no_errata_section', # whether to suppress the errata section
- 'complain_stderr', # whether to complain to stderr
-
- 'doc_has_started', # whether we've fired the open-Document event yet
-
- 'bare_output', # For some subclasses: whether to prepend
- # header-code and postpend footer-code
-
- 'fullstop_space_harden', # Whether to turn ". " into ".[nbsp] ";
-
- 'nix_X_codes', # whether to ignore X<...> codes
- 'merge_text', # whether to avoid breaking a single piece of
- # text up into several events
-
- 'preserve_whitespace', # whether to try to keep whitespace as-is
-
- 'content_seen', # whether we've seen any real Pod content
- 'errors_seen', # TODO: document. whether we've seen any errors (fatal or not)
-
- 'codes_in_verbatim', # for PseudoPod extensions
-
- 'code_handler', # coderef to call when a code (non-pod) line is seen
- 'cut_handler', # coderef to call when a =cut line is seen
- #Called like:
- # $code_handler->($line, $self->{'line_count'}, $self) if $code_handler;
- # $cut_handler->($line, $self->{'line_count'}, $self) if $cut_handler;
-
-);
-
-#@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
-
-sub any_errata_seen { # good for using as an exit() value...
- return shift->{'errors_seen'} || 0;
-}
-
-#@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
-# Pull in some functions that, for some reason, I expect to see here too:
-BEGIN {
- *pretty = \&Pod::Simple::BlackBox::pretty;
- *stringify_lol = \&Pod::Simple::BlackBox::stringify_lol;
-}
-
-#@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
-
-sub version_report {
- my $class = ref($_[0]) || $_[0];
- if($class eq __PACKAGE__) {
- return "$class $VERSION";
- } else {
- my $v = $class->VERSION;
- return "$class $v (" . __PACKAGE__ . " $VERSION)";
- }
-}
-
-#@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
-
-#sub curr_open { # read-only list accessor
-# return @{ $_[0]{'curr_open'} || return() };
-#}
-#sub _curr_open_listref { $_[0]{'curr_open'} ||= [] }
-
-
-sub output_string {
- # Works by faking out output_fh. Simplifies our code.
- #
- my $this = shift;
- return $this->{'output_string'} unless @_; # GET.
-
- require Pod::Simple::TiedOutFH;
- my $x = (defined($_[0]) and ref($_[0])) ? $_[0] : \( $_[0] );
- $$x = '' unless defined $$x;
- DEBUG > 4 and print "# Output string set to $x ($$x)\n";
- $this->{'output_fh'} = Pod::Simple::TiedOutFH->handle_on($_[0]);
- return
- $this->{'output_string'} = $_[0];
- #${ ${ $this->{'output_fh'} } };
-}
-
-sub abandon_output_string { $_[0]->abandon_output_fh; delete $_[0]{'output_string'} }
-sub abandon_output_fh { $_[0]->output_fh(undef) }
-# These don't delete the string or close the FH -- they just delete our
-# references to it/them.
-# TODO: document these
-
-#@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
-
-sub new {
- # takes no parameters
- my $class = ref($_[0]) || $_[0];
- #Carp::croak(__PACKAGE__ . " is a virtual base class -- see perldoc "
- # . __PACKAGE__ );
- return bless {
- 'accept_codes' => { map( ($_=>$_), @Known_formatting_codes ) },
- 'accept_directives' => { %Known_directives },
- 'accept_targets' => {},
- }, $class;
-}
-
-
-
-# TODO: an option for whether to interpolate E<...>'s, or just resolve to codes.
-
-#@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
-
-sub _handle_element_start { # OVERRIDE IN DERIVED CLASS
- my($self, $element_name, $attr_hash_r) = @_;
- return;
-}
-
-sub _handle_element_end { # OVERRIDE IN DERIVED CLASS
- my($self, $element_name) = @_;
- return;
-}
-
-sub _handle_text { # OVERRIDE IN DERIVED CLASS
- my($self, $text) = @_;
- return;
-}
-
-#@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
-#
-# And now directives (not targets)
-
-sub accept_directive_as_verbatim { shift->_accept_directives('Verbatim', @_) }
-sub accept_directive_as_data { shift->_accept_directives('Data', @_) }
-sub accept_directive_as_processed { shift->_accept_directives('Plain', @_) }
-
-sub _accept_directives {
- my($this, $type) = splice @_,0,2;
- foreach my $d (@_) {
- next unless defined $d and length $d;
- Carp::croak "\"$d\" isn't a valid directive name"
- unless $d =~ m/^[a-zA-Z][a-zA-Z0-9]*$/s;
- Carp::croak "\"$d\" is already a reserved Pod directive name"
- if exists $Known_directives{$d};
- $this->{'accept_directives'}{$d} = $type;
- DEBUG > 2 and print "Learning to accept \"=$d\" as directive of type $type\n";
- }
- DEBUG > 6 and print "$this\'s accept_directives : ",
- pretty($this->{'accept_directives'}), "\n";
-
- return sort keys %{ $this->{'accept_directives'} } if wantarray;
- return;
-}
-
-#--------------------------------------------------------------------------
-# TODO: document these:
-
-sub unaccept_directive { shift->unaccept_directives(@_) };
-
-sub unaccept_directives {
- my $this = shift;
- foreach my $d (@_) {
- next unless defined $d and length $d;
- Carp::croak "\"$d\" isn't a valid directive name"
- unless $d =~ m/^[a-zA-Z][a-zA-Z0-9]*$/s;
- Carp::croak "But you must accept \"$d\" directives -- it's a builtin!"
- if exists $Known_directives{$d};
- delete $this->{'accept_directives'}{$d};
- DEBUG > 2 and print "OK, won't accept \"=$d\" as directive.\n";
- }
- return sort keys %{ $this->{'accept_directives'} } if wantarray;
- return
-}
-
-#@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
-#
-# And now targets (not directives)
-
-sub accept_target { shift->accept_targets(@_) } # alias
-sub accept_target_as_text { shift->accept_targets_as_text(@_) } # alias
-
-
-sub accept_targets { shift->_accept_targets('1', @_) }
-
-sub accept_targets_as_text { shift->_accept_targets('force_resolve', @_) }
- # forces them to be processed, even when there's no ":".
-
-sub _accept_targets {
- my($this, $type) = splice @_,0,2;
- foreach my $t (@_) {
- next unless defined $t and length $t;
- # TODO: enforce some limitations on what a target name can be?
- $this->{'accept_targets'}{$t} = $type;
- DEBUG > 2 and print "Learning to accept \"$t\" as target of type $type\n";
- }
- return sort keys %{ $this->{'accept_targets'} } if wantarray;
- return;
-}
-
-#--------------------------------------------------------------------------
-sub unaccept_target { shift->unaccept_targets(@_) }
-
-sub unaccept_targets {
- my $this = shift;
- foreach my $t (@_) {
- next unless defined $t and length $t;
- # TODO: enforce some limitations on what a target name can be?
- delete $this->{'accept_targets'}{$t};
- DEBUG > 2 and print "OK, won't accept \"$t\" as target.\n";
- }
- return sort keys %{ $this->{'accept_targets'} } if wantarray;
- return;
-}
-
-#@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
-#
-# And now codes (not targets or directives)
-
-sub accept_code { shift->accept_codes(@_) } # alias
-
-sub accept_codes { # Add some codes
- my $this = shift;
-
- foreach my $new_code (@_) {
- next unless defined $new_code and length $new_code;
- if(ASCII) {
- # A good-enough check that it's good as an XML Name symbol:
- Carp::croak "\"$new_code\" isn't a valid element name"
- if $new_code =~
- m/[\x00-\x2C\x2F\x39\x3B-\x40\x5B-\x5E\x60\x7B-\x7F]/
- # Characters under 0x80 that aren't legal in an XML Name.
- or $new_code =~ m/^[-\.0-9]/s
- or $new_code =~ m/:[-\.0-9]/s;
- # The legal under-0x80 Name characters that
- # an XML Name still can't start with.
- }
-
- $this->{'accept_codes'}{$new_code} = $new_code;
-
- # Yes, map to itself -- just so that when we
- # see "=extend W [whatever] thatelementname", we say that W maps
- # to whatever $this->{accept_codes}{thatelementname} is,
- # i.e., "thatelementname". Then when we go re-mapping,
- # a "W" in the treelet turns into "thatelementname". We only
- # remap once.
- # If we say we accept "W", then a "W" in the treelet simply turns
- # into "W".
- }
-
- return;
-}
-
-#--------------------------------------------------------------------------
-sub unaccept_code { shift->unaccept_codes(@_) }
-
-sub unaccept_codes { # remove some codes
- my $this = shift;
-
- foreach my $new_code (@_) {
- next unless defined $new_code and length $new_code;
- if(ASCII) {
- # A good-enough check that it's good as an XML Name symbol:
- Carp::croak "\"$new_code\" isn't a valid element name"
- if $new_code =~
- m/[\x00-\x2C\x2F\x39\x3B-\x40\x5B-\x5E\x60\x7B-\x7F]/
- # Characters under 0x80 that aren't legal in an XML Name.
- or $new_code =~ m/^[-\.0-9]/s
- or $new_code =~ m/:[-\.0-9]/s;
- # The legal under-0x80 Name characters that
- # an XML Name still can't start with.
- }
-
- Carp::croak "But you must accept \"$new_code\" codes -- it's a builtin!"
- if grep $new_code eq $_, @Known_formatting_codes;
-
- delete $this->{'accept_codes'}{$new_code};
-
- DEBUG > 2 and print "OK, won't accept the code $new_code<...>.\n";
- }
-
- return;
-}
-
-
-#@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
-#@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
-
-sub parse_string_document {
- my $self = shift;
- my @lines;
- foreach my $line_group (@_) {
- next unless defined $line_group and length $line_group;
- pos($line_group) = 0;
- while($line_group =~
- m/([^\n\r]*)((?:\r?\n)?)/g
- ) {
- #print(">> $1\n"),
- $self->parse_lines($1)
- if length($1) or length($2)
- or pos($line_group) != length($line_group);
- # I.e., unless it's a zero-length "empty line" at the very
- # end of "foo\nbar\n" (i.e., between the \n and the EOS).
- }
- }
- $self->parse_lines(undef); # to signal EOF
- return $self;
-}
-
-sub _init_fh_source {
- my($self, $source) = @_;
-
- #DEBUG > 1 and print "Declaring $source as :raw for starters\n";
- #$self->_apply_binmode($source, ':raw');
- #binmode($source, ":raw");
-
- return;
-}
-
-#:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.
-#
-
-sub parse_file {
- my($self, $source) = (@_);
-
- if(!defined $source) {
- Carp::croak("Can't use empty-string as a source for parse_file");
- } elsif(ref(\$source) eq 'GLOB') {
- $self->{'source_filename'} = '' . ($source);
- } elsif(ref $source) {
- $self->{'source_filename'} = '' . ($source);
- } elsif(!length $source) {
- Carp::croak("Can't use empty-string as a source for parse_file");
- } else {
- {
- local *PODSOURCE;
- open(PODSOURCE, "<$source") || Carp::croak("Can't open $source: $!");
- $self->{'source_filename'} = $source;
- $source = *PODSOURCE{IO};
- }
- $self->_init_fh_source($source);
- }
- # By here, $source is a FH.
-
- $self->{'source_fh'} = $source;
-
- my($i, @lines);
- until( $self->{'source_dead'} ) {
- splice @lines;
- for($i = MANY_LINES; $i--;) { # read those many lines at a time
- local $/ = $NL;
- push @lines, scalar(<$source>); # readline
- last unless defined $lines[-1];
- # but pass thru the undef, which will set source_dead to true
- }
- $self->parse_lines(@lines);
- }
- delete($self->{'source_fh'}); # so it can be GC'd
- return $self;
-}
-
-#:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.
-
-sub parse_from_file {
- # An emulation of Pod::Parser's interface, for the sake of Perldoc.
- # Basically just a wrapper around parse_file.
-
- my($self, $source, $to) = @_;
- $self = $self->new unless ref($self); # so we tolerate being a class method
-
- if(!defined $source) { $source = *STDIN{IO}
- } elsif(ref(\$source) eq 'GLOB') { # stet
- } elsif(ref($source) ) { # stet
- } elsif(!length $source
- or $source eq '-' or $source =~ m/^<&(STDIN|0)$/i
- ) {
- $source = *STDIN{IO};
- }
-
- if(!defined $to) { $self->output_fh( *STDOUT{IO} );
- } elsif(ref(\$to) eq 'GLOB') { $self->output_fh( $to );
- } elsif(ref($to)) { $self->output_fh( $to );
- } elsif(!length $to
- or $to eq '-' or $to =~ m/^>&?(?:STDOUT|1)$/i
- ) {
- $self->output_fh( *STDOUT{IO} );
- } else {
- require Symbol;
- my $out_fh = Symbol::gensym();
- DEBUG and print "Write-opening to $to\n";
- open($out_fh, ">$to") or Carp::croak "Can't write-open $to: $!";
- binmode($out_fh)
- if $self->can('write_with_binmode') and $self->write_with_binmode;
- $self->output_fh($out_fh);
- }
-
- return $self->parse_file($source);
-}
-
-#-----------------------------------------------------------------------------
-
-sub whine {
- #my($self,$line,$complaint) = @_;
- my $self = shift(@_);
- ++$self->{'errors_seen'};
- if($self->{'no_whining'}) {
- DEBUG > 9 and print "Discarding complaint (at line $_[0]) $_[1]\n because no_whining is on.\n";
- return;
- }
- return $self->_complain_warn(@_) if $self->{'complain_stderr'};
- return $self->_complain_errata(@_);
-}
-
-sub scream { # like whine, but not suppressable
- #my($self,$line,$complaint) = @_;
- my $self = shift(@_);
- ++$self->{'errors_seen'};
- return $self->_complain_warn(@_) if $self->{'complain_stderr'};
- return $self->_complain_errata(@_);
-}
-
-sub _complain_warn {
- my($self,$line,$complaint) = @_;
- return printf STDERR "%s around line %s: %s\n",
- $self->{'source_filename'} || 'Pod input', $line, $complaint;
-}
-
-sub _complain_errata {
- my($self,$line,$complaint) = @_;
- if( $self->{'no_errata_section'} ) {
- DEBUG > 9 and print "Discarding erratum (at line $line) $complaint\n because no_errata_section is on.\n";
- } else {
- DEBUG > 9 and print "Queuing erratum (at line $line) $complaint\n";
- push @{$self->{'errata'}{$line}}, $complaint
- # for a report to be generated later!
- }
- return 1;
-}
-
-#@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
-
-sub _get_initial_item_type {
- # A hack-wrapper here for when you have like "=over\n\n=item 456\n\n"
- my($self, $para) = @_;
- return $para->[1]{'~type'} if $para->[1]{'~type'};
-
- return $para->[1]{'~type'} = 'text'
- if join("\n", @{$para}[2 .. $#$para]) =~ m/^\s*(\d+)\.?\s*$/s and $1 ne '1';
- # Else fall thru to the general case:
- return $self->_get_item_type($para);
-}
-
-
-
-sub _get_item_type { # mutates the item!!
- my($self, $para) = @_;
- return $para->[1]{'~type'} if $para->[1]{'~type'};
-
-
- # Otherwise we haven't yet been to this node. Maybe alter it...
-
- my $content = join "\n", @{$para}[2 .. $#$para];
-
- if($content =~ m/^\s*\*\s*$/s or $content =~ m/^\s*$/s) {
- # Like: "=item *", "=item * ", "=item"
- splice @$para, 2; # so it ends up just being ['=item', { attrhash } ]
- $para->[1]{'~orig_content'} = $content;
- return $para->[1]{'~type'} = 'bullet';
-
- } elsif($content =~ m/^\s*\*\s+(.+)/s) { # tolerance
-
- # Like: "=item * Foo bar baz";
- $para->[1]{'~orig_content'} = $content;
- $para->[1]{'~_freaky_para_hack'} = $1;
- DEBUG > 2 and print " Tolerating $$para[2] as =item *\\n\\n$1\n";
- splice @$para, 2; # so it ends up just being ['=item', { attrhash } ]
- return $para->[1]{'~type'} = 'bullet';
-
- } elsif($content =~ m/^\s*(\d+)\.?\s*$/s) {
- # Like: "=item 1.", "=item 123412"
-
- $para->[1]{'~orig_content'} = $content;
- $para->[1]{'number'} = $1; # Yes, stores the number there!
-
- splice @$para, 2; # so it ends up just being ['=item', { attrhash } ]
- return $para->[1]{'~type'} = 'number';
-
- } else {
- # It's anything else.
- return $para->[1]{'~type'} = 'text';
-
- }
-}
-
-#-----------------------------------------------------------------------------
-
-sub _make_treelet {
- my $self = shift; # and ($para, $start_line)
- my $treelet;
- if(!@_) {
- return [''];
- } if(ref $_[0] and ref $_[0][0] and $_[0][0][0] eq '~Top') {
- # Hack so we can pass in fake-o pre-cooked paragraphs:
- # just have the first line be a reference to a ['~Top', {}, ...]
- # We use this feechure in gen_errata and stuff.
-
- DEBUG and print "Applying precooked treelet hack to $_[0][0]\n";
- $treelet = $_[0][0];
- splice @$treelet, 0, 2; # lop the top off
- return $treelet;
- } else {
- $treelet = $self->_treelet_from_formatting_codes(@_);
- }
-
- if( $self->_remap_sequences($treelet) ) {
- $self->_treat_Zs($treelet); # Might as well nix these first
- $self->_treat_Ls($treelet); # L has to precede E and S
- $self->_treat_Es($treelet);
- $self->_treat_Ss($treelet); # S has to come after E
-
- $self->_wrap_up($treelet); # Nix X's and merge texties
-
- } else {
- DEBUG and print "Formatless treelet gets fast-tracked.\n";
- # Very common case!
- }
-
- splice @$treelet, 0, 2; # lop the top off
-
- return $treelet;
-}
-
-#:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.
-
-sub _wrap_up {
- my($self, @stack) = @_;
- my $nixx = $self->{'nix_X_codes'};
- my $merge = $self->{'merge_text' };
- return unless $nixx or $merge;
-
- DEBUG > 2 and print "\nStarting _wrap_up traversal.\n",
- $merge ? (" Merge mode on\n") : (),
- $nixx ? (" Nix-X mode on\n") : (),
- ;
-
-
- my($i, $treelet);
- while($treelet = shift @stack) {
- DEBUG > 3 and print " Considering children of this $treelet->[0] node...\n";
- for($i = 2; $i < @$treelet; ++$i) { # iterate over children
- DEBUG > 3 and print " Considering child at $i ", pretty($treelet->[$i]), "\n";
- if($nixx and ref $treelet->[$i] and $treelet->[$i][0] eq 'X') {
- DEBUG > 3 and print " Nixing X node at $i\n";
- splice(@$treelet, $i, 1); # just nix this node (and its descendants)
- # no need to back-update the counter just yet
- redo;
-
- } elsif($merge and $i != 2 and # non-initial
- !ref $treelet->[$i] and !ref $treelet->[$i - 1]
- ) {
- DEBUG > 3 and print " Merging ", $i-1,
- ":[$treelet->[$i-1]] and $i\:[$treelet->[$i]]\n";
- $treelet->[$i-1] .= ( splice(@$treelet, $i, 1) )[0];
- DEBUG > 4 and print " Now: ", $i-1, ":[$treelet->[$i-1]]\n";
- --$i;
- next;
- # since we just pulled the possibly last node out from under
- # ourselves, we can't just redo()
-
- } elsif( ref $treelet->[$i] ) {
- DEBUG > 4 and print " Enqueuing ", pretty($treelet->[$i]), " for traversal.\n";
- push @stack, $treelet->[$i];
-
- if($treelet->[$i][0] eq 'L') {
- my $thing;
- foreach my $attrname ('section', 'to') {
- if(defined($thing = $treelet->[$i][1]{$attrname}) and ref $thing) {
- unshift @stack, $thing;
- DEBUG > 4 and print " +Enqueuing ",
- pretty( $treelet->[$i][1]{$attrname} ),
- " as an attribute value to tweak.\n";
- }
- }
- }
- }
- }
- }
- DEBUG > 2 and print "End of _wrap_up traversal.\n\n";
-
- return;
-}
-
-#:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.
-
-sub _remap_sequences {
- my($self,@stack) = @_;
-
- if(@stack == 1 and @{ $stack[0] } == 3 and !ref $stack[0][2]) {
- # VERY common case: abort it.
- DEBUG and print "Skipping _remap_sequences: formatless treelet.\n";
- return 0;
- }
-
- my $map = ($self->{'accept_codes'} || die "NO accept_codes in $self?!?");
-
- my $start_line = $stack[0][1]{'start_line'};
- DEBUG > 2 and printf
- "\nAbout to start _remap_sequences on treelet from line %s.\n",
- $start_line || '[?]'
- ;
- DEBUG > 3 and print " Map: ",
- join('; ', map "$_=" . (
- ref($map->{$_}) ? join(",", @{$map->{$_}}) : $map->{$_}
- ),
- sort keys %$map ),
- ("B~C~E~F~I~L~S~X~Z" eq join '~', sort keys %$map)
- ? " (all normal)\n" : "\n"
- ;
-
- # A recursive algorithm implemented iteratively! Whee!
-
- my($is, $was, $i, $treelet); # scratch
- while($treelet = shift @stack) {
- DEBUG > 3 and print " Considering children of this $treelet->[0] node...\n";
- for($i = 2; $i < @$treelet; ++$i) { # iterate over children
- next unless ref $treelet->[$i]; # text nodes are uninteresting
-
- DEBUG > 4 and print " Noting child $i : $treelet->[$i][0]<...>\n";
-
- $is = $treelet->[$i][0] = $map->{ $was = $treelet->[$i][0] };
- if( DEBUG > 3 ) {
- if(!defined $is) {
- print " Code $was<> is UNKNOWN!\n";
- } elsif($is eq $was) {
- DEBUG > 4 and print " Code $was<> stays the same.\n";
- } else {
- print " Code $was<> maps to ",
- ref($is)
- ? ( "tags ", map("$_<", @$is), '...', map('>', @$is), "\n" )
- : "tag $is<...>.\n";
- }
- }
-
- if(!defined $is) {
- $self->whine($start_line, "Deleting unknown formatting code $was<>");
- $is = $treelet->[$i][0] = '1'; # But saving the children!
- # I could also insert a leading "$was<" and tailing ">" as
- # children of this node, but something about that seems icky.
- }
- if(ref $is) {
- my @dynasty = @$is;
- DEBUG > 4 and print " Renaming $was node to $dynasty[-1]\n";
- $treelet->[$i][0] = pop @dynasty;
- my $nugget;
- while(@dynasty) {
- DEBUG > 4 and printf
- " Grafting a new %s node between %s and %s\n",
- $dynasty[-1], $treelet->[0], $treelet->[$i][0],
- ;
-
- #$nugget = ;
- splice @$treelet, $i, 1, [pop(@dynasty), {}, $treelet->[$i]];
- # relace node with a new parent
- }
- } elsif($is eq '0') {
- splice(@$treelet, $i, 1); # just nix this node (and its descendants)
- --$i; # back-update the counter
- } elsif($is eq '1') {
- splice(@$treelet, $i, 1 # replace this node with its children!
- => splice @{ $treelet->[$i] },2
- # (not catching its first two (non-child) items)
- );
- --$i; # back up for new stuff
- } else {
- # otherwise it's unremarkable
- unshift @stack, $treelet->[$i]; # just recurse
- }
- }
- }
-
- DEBUG > 2 and print "End of _remap_sequences traversal.\n\n";
-
- if(@_ == 2 and @{ $_[1] } == 3 and !ref $_[1][2]) {
- DEBUG and print "Noting that the treelet is now formatless.\n";
- return 0;
- }
- return 1;
-}
-
-# . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
-
-sub _ponder_extend {
-
- # "Go to an extreme, move back to a more comfortable place"
- # -- /Oblique Strategies/, Brian Eno and Peter Schmidt
-
- my($self, $para) = @_;
- my $content = join ' ', splice @$para, 2;
- $content =~ s/^\s+//s;
- $content =~ s/\s+$//s;
-
- DEBUG > 2 and print "Ogling extensor: =extend $content\n";
-
- if($content =~
- m/^
- (\S+) # 1 : new item
- \s+
- (\S+) # 2 : fallback(s)
- (?:\s+(\S+))? # 3 : element name(s)
- \s*
- $
- /xs
- ) {
- my $new_letter = $1;
- my $fallbacks_one = $2;
- my $elements_one;
- $elements_one = defined($3) ? $3 : $1;
-
- DEBUG > 2 and print "Extensor has good syntax.\n";
-
- unless($new_letter =~ m/^[A-Z]$/s or $new_letter) {
- DEBUG > 2 and print " $new_letter isn't a valid thing to entend.\n";
- $self->whine(
- $para->[1]{'start_line'},
- "You can extend only formatting codes A-Z, not like \"$new_letter\""
- );
- return;
- }
-
- if(grep $new_letter eq $_, @Known_formatting_codes) {
- DEBUG > 2 and print " $new_letter isn't a good thing to extend, because known.\n";
- $self->whine(
- $para->[1]{'start_line'},
- "You can't extend an established code like \"$new_letter\""
- );
-
- #TODO: or allow if last bit is same?
-
- return;
- }
-
- unless($fallbacks_one =~ m/^[A-Z](,[A-Z])*$/s # like "B", "M,I", etc.
- or $fallbacks_one eq '0' or $fallbacks_one eq '1'
- ) {
- $self->whine(
- $para->[1]{'start_line'},
- "Format for second =extend parameter must be like"
- . " M or 1 or 0 or M,N or M,N,O but you have it like "
- . $fallbacks_one
- );
- return;
- }
-
- unless($elements_one =~ m/^[^ ,]+(,[^ ,]+)*$/s) { # like "B", "M,I", etc.
- $self->whine(
- $para->[1]{'start_line'},
- "Format for third =extend parameter: like foo or bar,Baz,qu:ux but not like "
- . $elements_one
- );
- return;
- }
-
- my @fallbacks = split ',', $fallbacks_one, -1;
- my @elements = split ',', $elements_one, -1;
-
- foreach my $f (@fallbacks) {
- next if exists $Known_formatting_codes{$f} or $f eq '0' or $f eq '1';
- DEBUG > 2 and print " Can't fall back on unknown code $f\n";
- $self->whine(
- $para->[1]{'start_line'},
- "Can't use unknown formatting code '$f' as a fallback for '$new_letter'"
- );
- return;
- }
-
- DEBUG > 3 and printf "Extensor: Fallbacks <%s> Elements <%s>.\n",
- @fallbacks, @elements;
-
- my $canonical_form;
- foreach my $e (@elements) {
- if(exists $self->{'accept_codes'}{$e}) {
- DEBUG > 1 and print " Mapping '$new_letter' to known extension '$e'\n";
- $canonical_form = $e;
- last; # first acceptable elementname wins!
- } else {
- DEBUG > 1 and print " Can't map '$new_letter' to unknown extension '$e'\n";
- }
- }
-
-
- if( defined $canonical_form ) {
- # We found a good N => elementname mapping
- $self->{'accept_codes'}{$new_letter} = $canonical_form;
- DEBUG > 2 and print
- "Extensor maps $new_letter => known element $canonical_form.\n";
- } else {
- # We have to use the fallback(s), which might be '0', or '1'.
- $self->{'accept_codes'}{$new_letter}
- = (@fallbacks == 1) ? $fallbacks[0] : \@fallbacks;
- DEBUG > 2 and print
- "Extensor maps $new_letter => fallbacks @fallbacks.\n";
- }
-
- } else {
- DEBUG > 2 and print "Extensor has bad syntax.\n";
- $self->whine(
- $para->[1]{'start_line'},
- "Unknown =extend syntax: $content"
- )
- }
- return;
-}
-
-
-#:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.
-
-sub _treat_Zs { # Nix Z<...>'s
- my($self,@stack) = @_;
-
- my($i, $treelet);
- my $start_line = $stack[0][1]{'start_line'};
-
- # A recursive algorithm implemented iteratively! Whee!
-
- while($treelet = shift @stack) {
- for($i = 2; $i < @$treelet; ++$i) { # iterate over children
- next unless ref $treelet->[$i]; # text nodes are uninteresting
- unless($treelet->[$i][0] eq 'Z') {
- unshift @stack, $treelet->[$i]; # recurse
- next;
- }
-
- DEBUG > 1 and print "Nixing Z node @{$treelet->[$i]}\n";
-
- # bitch UNLESS it's empty
- unless( @{$treelet->[$i]} == 2
- or (@{$treelet->[$i]} == 3 and $treelet->[$i][2] eq '')
- ) {
- $self->whine( $start_line, "A non-empty Z<>" );
- } # but kill it anyway
-
- splice(@$treelet, $i, 1); # thereby just nix this node.
- --$i;
-
- }
- }
-
- return;
-}
-
-# . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
-
-# Quoting perlpodspec:
-
-# In parsing an L<...> code, Pod parsers must distinguish at least four
-# attributes:
-
-############# Not used. Expressed via the element children plus
-############# the value of the "content-implicit" flag.
-# First:
-# The link-text. If there is none, this must be undef. (E.g., in "L<Perl
-# Functions|perlfunc>", the link-text is "Perl Functions". In
-# "L<Time::HiRes>" and even "L<|Time::HiRes>", there is no link text. Note
-# that link text may contain formatting.)
-#
-
-############# The element children
-# Second:
-# The possibly inferred link-text -- i.e., if there was no real link text,
-# then this is the text that we'll infer in its place. (E.g., for
-# "L<Getopt::Std>", the inferred link text is "Getopt::Std".)
-#
-
-############# The "to" attribute (which might be text, or a treelet)
-# Third:
-# The name or URL, or undef if none. (E.g., in "L<Perl
-# Functions|perlfunc>", the name -- also sometimes called the page -- is
-# "perlfunc". In "L</CAVEATS>", the name is undef.)
-#
-
-############# The "section" attribute (which might be next, or a treelet)
-# Fourth:
-# The section (AKA "item" in older perlpods), or undef if none. E.g., in
-# Getopt::Std/DESCRIPTION, "DESCRIPTION" is the section. (Note that this
-# is not the same as a manpage section like the "5" in "man 5 crontab".
-# "Section Foo" in the Pod sense means the part of the text that's
-# introduced by the heading or item whose text is "Foo".)
-#
-# Pod parsers may also note additional attributes including:
-#
-
-############# The "type" attribute.
-# Fifth:
-# A flag for whether item 3 (if present) is a URL (like
-# "http://lists.perl.org" is), in which case there should be no section
-# attribute; a Pod name (like "perldoc" and "Getopt::Std" are); or
-# possibly a man page name (like "crontab(5)" is).
-#
-
-############# Not implemented, I guess.
-# Sixth:
-# The raw original L<...> content, before text is split on "|", "/", etc,
-# and before E<...> codes are expanded.
-
-
-# For L<...> codes without a "name|" part, only E<...> and Z<> codes may
-# occur -- no other formatting codes. That is, authors should not use
-# "L<B<Foo::Bar>>".
-#
-# Note, however, that formatting codes and Z<>'s can occur in any and all
-# parts of an L<...> (i.e., in name, section, text, and url).
-
-sub _treat_Ls { # Process our dear dear friends, the L<...> sequences
-
- # L<name>
- # L<name/"sec"> or L<name/sec>
- # L</"sec"> or L</sec> or L<"sec">
- # L<text|name>
- # L<text|name/"sec"> or L<text|name/sec>
- # L<text|/"sec"> or L<text|/sec> or L<text|"sec">
- # L<scheme:...>
-
- my($self,@stack) = @_;
-
- my($i, $treelet);
- my $start_line = $stack[0][1]{'start_line'};
-
- # A recursive algorithm implemented iteratively! Whee!
-
- while($treelet = shift @stack) {
- for(my $i = 2; $i < @$treelet; ++$i) {
- # iterate over children of current tree node
- next unless ref $treelet->[$i]; # text nodes are uninteresting
- unless($treelet->[$i][0] eq 'L') {
- unshift @stack, $treelet->[$i]; # recurse
- next;
- }
-
-
- # By here, $treelet->[$i] is definitely an L node
- DEBUG > 1 and print "Ogling L node $treelet->[$i]\n";
-
- # bitch if it's empty
- if( @{$treelet->[$i]} == 2
- or (@{$treelet->[$i]} == 3 and $treelet->[$i][2] eq '')
- ) {
- $self->whine( $start_line, "An empty L<>" );
- $treelet->[$i] = 'L<>'; # just make it a text node
- next; # and move on
- }
-
- # Catch URLs:
- # URLs can, alas, contain E<...> sequences, so we can't /assume/
- # that this is one text node. But it has to START with one text
- # node...
- if(! ref $treelet->[$i][2] and
- $treelet->[$i][2] =~ m/^\w+:[^:\s]\S*$/s
- ) {
- $treelet->[$i][1]{'type'} = 'url';
- $treelet->[$i][1]{'content-implicit'} = 'yes';
-
- # TODO: deal with rel: URLs here?
-
- if( 3 == @{ $treelet->[$i] } ) {
- # But if it IS just one text node (most common case)
- DEBUG > 1 and printf qq{Catching "%s as " as ho-hum L<URL> link.\n},
- $treelet->[$i][2]
- ;
- $treelet->[$i][1]{'to'} = Pod::Simple::LinkSection->new(
- $treelet->[$i][2]
- ); # its own treelet
- } else {
- # It's a URL but complex (like "L<foo:bazE<123>bar>"). Feh.
- #$treelet->[$i][1]{'to'} = [ @{$treelet->[$i]} ];
- #splice @{ $treelet->[$i][1]{'to'} }, 0,2;
- #DEBUG > 1 and printf qq{Catching "%s as " as complex L<URL> link.\n},
- # join '~', @{$treelet->[$i][1]{'to' }};
-
- $treelet->[$i][1]{'to'} = Pod::Simple::LinkSection->new(
- $treelet->[$i] # yes, clone the whole content as a treelet
- );
- $treelet->[$i][1]{'to'}[0] = ''; # set the copy's tagname to nil
- die "SANITY FAILURE" if $treelet->[0] eq ''; # should never happen!
- DEBUG > 1 and print
- qq{Catching "$treelet->[$i][1]{'to'}" as a complex L<URL> link.\n};
- }
-
- next; # and move on
- }
-
-
- # Catch some very simple and/or common cases
- if(@{$treelet->[$i]} == 3 and ! ref $treelet->[$i][2]) {
- my $it = $treelet->[$i][2];
- if($it =~ m/^[-a-zA-Z0-9]+\([-a-zA-Z0-9]+\)$/s) { # man sections
- # Hopefully neither too broad nor too restrictive a RE
- DEBUG > 1 and print "Catching \"$it\" as manpage link.\n";
- $treelet->[$i][1]{'type'} = 'man';
- # This's the only place where man links can get made.
- $treelet->[$i][1]{'content-implicit'} = 'yes';
- $treelet->[$i][1]{'to' } =
- Pod::Simple::LinkSection->new( $it ); # treelet!
-
- next;
- }
- if($it =~ m/^[^\/\|,\$\%\@\ \"\<\>\:\#\&\*\{\}\[\]\(\)]+(\:\:[^\/\|,\$\%\@\ \"\<\>\:\#\&\*\{\}\[\]\(\)]+)*$/s) {
- # Extremely forgiving idea of what constitutes a bare
- # modulename link like L<Foo::Bar> or even L<Thing::1.0::Docs::Tralala>
- DEBUG > 1 and print "Catching \"$it\" as ho-hum L<Modulename> link.\n";
- $treelet->[$i][1]{'type'} = 'pod';
- $treelet->[$i][1]{'content-implicit'} = 'yes';
- $treelet->[$i][1]{'to' } =
- Pod::Simple::LinkSection->new( $it ); # treelet!
- next;
- }
- # else fall thru...
- }
-
-
-
- # ...Uhoh, here's the real L<...> parsing stuff...
- # "With the ill behavior, with the ill behavior, with the ill behavior..."
-
- DEBUG > 1 and print "Running a real parse on this non-trivial L\n";
-
-
- my $link_text; # set to an arrayref if found
- my $ell = $treelet->[$i];
- my @ell_content = @$ell;
- splice @ell_content,0,2; # Knock off the 'L' and {} bits
-
- DEBUG > 3 and print " Ell content to start: ",
- pretty(@ell_content), "\n";
-
-
- # Look for the "|" -- only in CHILDREN (not all underlings!)
- # Like L<I like the strictness|strict>
- DEBUG > 3 and
- print " Peering at L content for a '|' ...\n";
- for(my $j = 0; $j < @ell_content; ++$j) {
- next if ref $ell_content[$j];
- DEBUG > 3 and
- print " Peering at L-content text bit \"$ell_content[$j]\" for a '|'.\n";
-
- if($ell_content[$j] =~ m/^([^\|]*)\|(.*)$/s) {
- my @link_text = ($1); # might be 0-length
- $ell_content[$j] = $2; # might be 0-length
-
- DEBUG > 3 and
- print " FOUND a '|' in it. Splitting into [$1] + [$2]\n";
-
- unshift @link_text, splice @ell_content, 0, $j;
- # leaving only things at J and after
- @ell_content = grep ref($_)||length($_), @ell_content ;
- $link_text = [grep ref($_)||length($_), @link_text ];
- DEBUG > 3 and printf
- " So link text is %s\n and remaining ell content is %s\n",
- pretty($link_text), pretty(@ell_content);
- last;
- }
- }
-
-
- # Now look for the "/" -- only in CHILDREN (not all underlings!)
- # And afterward, anything left in @ell_content will be the raw name
- # Like L<Foo::Bar/Object Methods>
- my $section_name; # set to arrayref if found
- DEBUG > 3 and print " Peering at L-content for a '/' ...\n";
- for(my $j = 0; $j < @ell_content; ++$j) {
- next if ref $ell_content[$j];
- DEBUG > 3 and
- print " Peering at L-content text bit \"$ell_content[$j]\" for a '/'.\n";
-
- if($ell_content[$j] =~ m/^([^\/]*)\/(.*)$/s) {
- my @section_name = ($2); # might be 0-length
- $ell_content[$j] = $1; # might be 0-length
-
- DEBUG > 3 and
- print " FOUND a '/' in it.",
- " Splitting to page [...$1] + section [$2...]\n";
-
- push @section_name, splice @ell_content, 1+$j;
- # leaving only things before and including J
-
- @ell_content = grep ref($_)||length($_), @ell_content ;
- @section_name = grep ref($_)||length($_), @section_name ;
-
- # Turn L<.../"foo"> into L<.../foo>
- if(@section_name
- and !ref($section_name[0]) and !ref($section_name[-1])
- and $section_name[ 0] =~ m/^\"/s
- and $section_name[-1] =~ m/\"$/s
- and !( # catch weird degenerate case of L<"> !
- @section_name == 1 and $section_name[0] eq '"'
- )
- ) {
- $section_name[ 0] =~ s/^\"//s;
- $section_name[-1] =~ s/\"$//s;
- DEBUG > 3 and
- print " Quotes removed: ", pretty(@section_name), "\n";
- } else {
- DEBUG > 3 and
- print " No need to remove quotes in ", pretty(@section_name), "\n";
- }
-
- $section_name = \@section_name;
- last;
- }
- }
-
- # Turn L<"Foo Bar"> into L</Foo Bar>
- if(!$section_name and @ell_content
- and !ref($ell_content[0]) and !ref($ell_content[-1])
- and $ell_content[ 0] =~ m/^\"/s
- and $ell_content[-1] =~ m/\"$/s
- and !( # catch weird degenerate case of L<"> !
- @ell_content == 1 and $ell_content[0] eq '"'
- )
- ) {
- $section_name = [splice @ell_content];
- $section_name->[ 0] =~ s/^\"//s;
- $section_name->[-1] =~ s/\"$//s;
- }
-
- # Turn L<Foo Bar> into L</Foo Bar>.
- if(!$section_name and !$link_text and @ell_content
- and grep !ref($_) && m/ /s, @ell_content
- ) {
- $section_name = [splice @ell_content];
- # That's support for the now-deprecated syntax.
- # (Maybe generate a warning eventually?)
- # Note that it deliberately won't work on L<...|Foo Bar>
- }
-
-
- # Now make up the link_text
- # L<Foo> -> L<Foo|Foo>
- # L</Bar> -> L<"Bar"|Bar>
- # L<Foo/Bar> -> L<"Bar" in Foo/Foo>
- unless($link_text) {
- $ell->[1]{'content-implicit'} = 'yes';
- $link_text = [];
- push @$link_text, '"', @$section_name, '"' if $section_name;
-
- if(@ell_content) {
- $link_text->[-1] .= ' in ' if $section_name;
- push @$link_text, @ell_content;
- }
- }
-
-
- # And the E resolver will have to deal with all our treeletty things:
-
- if(@ell_content == 1 and !ref($ell_content[0])
- and $ell_content[0] =~ m/^[-a-zA-Z0-9]+\([-a-zA-Z0-9]+\)$/s
- ) {
- $ell->[1]{'type'} = 'man';
- DEBUG > 3 and print "Considering this ($ell_content[0]) a man link.\n";
- } else {
- $ell->[1]{'type'} = 'pod';
- DEBUG > 3 and print "Considering this a pod link (not man or url).\n";
- }
-
- if( defined $section_name ) {
- $ell->[1]{'section'} = Pod::Simple::LinkSection->new(
- ['', {}, @$section_name]
- );
- DEBUG > 3 and print "L-section content: ", pretty($ell->[1]{'section'}), "\n";
- }
-
- if( @ell_content ) {
- $ell->[1]{'to'} = Pod::Simple::LinkSection->new(
- ['', {}, @ell_content]
- );
- DEBUG > 3 and print "L-to content: ", pretty($ell->[1]{'to'}), "\n";
- }
-
- # And update children to be the link-text:
- @$ell = (@$ell[0,1], defined($link_text) ? splice(@$link_text) : '');
-
- DEBUG > 2 and print "End of L-parsing for this node $treelet->[$i]\n";
-
- unshift @stack, $treelet->[$i]; # might as well recurse
- }
- }
-
- return;
-}
-
-# . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
-
-sub _treat_Es {
- my($self,@stack) = @_;
-
- my($i, $treelet, $content, $replacer, $charnum);
- my $start_line = $stack[0][1]{'start_line'};
-
- # A recursive algorithm implemented iteratively! Whee!
-
-
- # Has frightening side effects on L nodes' attributes.
-
- #my @ells_to_tweak;
-
- while($treelet = shift @stack) {
- for(my $i = 2; $i < @$treelet; ++$i) { # iterate over children
- next unless ref $treelet->[$i]; # text nodes are uninteresting
- if($treelet->[$i][0] eq 'L') {
- # SPECIAL STUFF for semi-processed L<>'s
-
- my $thing;
- foreach my $attrname ('section', 'to') {
- if(defined($thing = $treelet->[$i][1]{$attrname}) and ref $thing) {
- unshift @stack, $thing;
- DEBUG > 2 and print " Enqueuing ",
- pretty( $treelet->[$i][1]{$attrname} ),
- " as an attribute value to tweak.\n";
- }
- }
-
- unshift @stack, $treelet->[$i]; # recurse
- next;
- } elsif($treelet->[$i][0] ne 'E') {
- unshift @stack, $treelet->[$i]; # recurse
- next;
- }
-
- DEBUG > 1 and print "Ogling E node ", pretty($treelet->[$i]), "\n";
-
- # bitch if it's empty
- if( @{$treelet->[$i]} == 2
- or (@{$treelet->[$i]} == 3 and $treelet->[$i][2] eq '')
- ) {
- $self->whine( $start_line, "An empty E<>" );
- $treelet->[$i] = 'E<>'; # splice in a literal
- next;
- }
-
- # bitch if content is weird
- unless(@{$treelet->[$i]} == 3 and !ref($content = $treelet->[$i][2])) {
- $self->whine( $start_line, "An E<...> surrounding strange content" );
- $replacer = $treelet->[$i]; # scratch
- splice(@$treelet, $i, 1, # fake out a literal
- 'E<',
- splice(@$replacer,2), # promote its content
- '>'
- );
- # Don't need to do --$i, as the 'E<' we just added isn't interesting.
- next;
- }
-
- DEBUG > 1 and print "Ogling E<$content>\n";
-
- $charnum = Pod::Escapes::e2charnum($content);
- DEBUG > 1 and print " Considering E<$content> with char ",
- defined($charnum) ? $charnum : "undef", ".\n";
-
- if(!defined( $charnum )) {
- DEBUG > 1 and print "I don't know how to deal with E<$content>.\n";
- $self->whine( $start_line, "Unknown E content in E<$content>" );
- $replacer = "E<$content>"; # better than nothing
- } elsif($charnum >= 255 and !UNICODE) {
- $replacer = ASCII ? "\xA4" : "?";
- DEBUG > 1 and print "This Perl version can't handle ",
- "E<$content> (chr $charnum), so replacing with $replacer\n";
- } else {
- $replacer = Pod::Escapes::e2char($content);
- DEBUG > 1 and print " Replacing E<$content> with $replacer\n";
- }
-
- splice(@$treelet, $i, 1, $replacer); # no need to back up $i, tho
- }
- }
-
- return;
-}
-
-
-# . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
-
-sub _treat_Ss {
- my($self,$treelet) = @_;
-
- _change_S_to_nbsp($treelet,0) if $self->{'nbsp_for_S'};
-
- # TODO: or a change_nbsp_to_S
- # Normalizing nbsp's to S is harder: for each text node, make S content
- # out of anything matching m/([^ \xA0]*(?:\xA0+[^ \xA0]*)+)/
-
-
- return;
-}
-
-
-sub _change_S_to_nbsp { # a recursive function
- # Sanely assumes that the top node in the excursion won't be an S node.
- my($treelet, $in_s) = @_;
-
- my $is_s = ('S' eq $treelet->[0]);
- $in_s ||= $is_s; # So in_s is on either by this being an S element,
- # or by an ancestor being an S element.
-
- for(my $i = 2; $i < @$treelet; ++$i) {
- if(ref $treelet->[$i]) {
- if( _change_S_to_nbsp( $treelet->[$i], $in_s ) ) {
- my $to_pull_up = $treelet->[$i];
- splice @$to_pull_up,0,2; # ...leaving just its content
- splice @$treelet, $i, 1, @$to_pull_up; # Pull up content
- $i += @$to_pull_up - 1; # Make $i skip the pulled-up stuff
- }
- } else {
- $treelet->[$i] =~ s/\s/\xA0/g if ASCII and $in_s;
- # (If not in ASCIIland, we can't assume that \xA0 == nbsp.)
-
- # Note that if you apply nbsp_for_S to text, and so turn
- # "foo S<bar baz> quux" into "foo bar&#160;faz quux", you
- # end up with something that fails to say "and don't hyphenate
- # any part of 'bar baz'". However, hyphenation is such a vexing
- # problem anyway, that most Pod renderers just don't render it
- # at all. But if you do want to implement hyphenation, I guess
- # that you'd better have nbsp_for_S off.
- }
- }
-
- return $is_s;
-}
-
-#-----------------------------------------------------------------------------
-
-sub _accessorize { # A simple-minded method-maker
- no strict 'refs';
- foreach my $attrname (@_) {
- next if $attrname =~ m/::/; # a hack
- *{caller() . '::' . $attrname} = sub {
- use strict;
- $Carp::CarpLevel = 1, Carp::croak(
- "Accessor usage: \$obj->$attrname() or \$obj->$attrname(\$new_value)"
- ) unless (@_ == 1 or @_ == 2) and ref $_[0];
- (@_ == 1) ? $_[0]->{$attrname}
- : ($_[0]->{$attrname} = $_[1]);
- };
- }
- # Ya know, they say accessories make the ensemble!
- return;
-}
-
-# . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
-# . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
-#=============================================================================
-
-sub filter {
- my($class, $source) = @_;
- my $new = $class->new;
- $new->output_fh(*STDOUT{IO});
-
- if(ref($source || '') eq 'SCALAR') {
- $new->parse_string_document( $$source );
- } elsif(ref($source)) { # it's a file handle
- $new->parse_file($source);
- } else { # it's a filename
- $new->parse_file($source);
- }
-
- return $new;
-}
-
-
-#-----------------------------------------------------------------------------
-
-sub _out {
- # For use in testing: Class->_out($source)
- # returns the transformation of $source
-
- my $class = shift(@_);
-
- my $mutor = shift(@_) if @_ and ref($_[0] || '') eq 'CODE';
-
- DEBUG and print "\n\n", '#' x 76,
- "\nAbout to parse source: {{\n$_[0]\n}}\n\n";
-
-
- my $parser = $class->new;
- $parser->hide_line_numbers(1);
-
- my $out = '';
- $parser->output_string( \$out );
- DEBUG and print " _out to ", \$out, "\n";
-
- $mutor->($parser) if $mutor;
-
- $parser->parse_string_document( $_[0] );
- # use Data::Dumper; print Dumper($parser), "\n";
- return $out;
-}
-
-
-sub _duo {
- # For use in testing: Class->_duo($source1, $source2)
- # returns the parse trees of $source1 and $source2.
- # Good in things like: &ok( Class->duo(... , ...) );
-
- my $class = shift(@_);
-
- Carp::croak "But $class->_duo is useful only in list context!"
- unless wantarray;
-
- my $mutor = shift(@_) if @_ and ref($_[0] || '') eq 'CODE';
-
- Carp::croak "But $class->_duo takes two parameters, not: @_"
- unless @_ == 2;
-
- my(@out);
-
- while( @_ ) {
- my $parser = $class->new;
-
- push @out, '';
- $parser->output_string( \( $out[-1] ) );
-
- DEBUG and print " _duo out to ", $parser->output_string(),
- " = $parser->{'output_string'}\n";
-
- $parser->hide_line_numbers(1);
- $mutor->($parser) if $mutor;
- $parser->parse_string_document( shift( @_ ) );
- # use Data::Dumper; print Dumper($parser), "\n";
- }
-
- return @out;
-}
-
-
-
-#-----------------------------------------------------------------------------
-1;
-__END__
-
-TODO:
-A start_formatting_code and end_formatting_code methods, which in the
-base class call start_L, end_L, start_C, end_C, etc., if they are
-defined.
-
-have the POD FORMATTING ERRORS section note the localtime, and the
-version of Pod::Simple.
-
-option to delete all E<shy>s?
-option to scream if under-0x20 literals are found in the input, or
-under-E<32> E codes are found in the tree. And ditto \x7f-\x9f
-
-Option to turn highbit characters into their compromised form? (applies
-to E parsing too)
-
-TODO: BOM/encoding things.
-
-TODO: ascii-compat things in the XML classes?
-
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Pod/Simple.pod b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Pod/Simple.pod
deleted file mode 100644
index b0a8a6f6d08..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Pod/Simple.pod
+++ /dev/null
@@ -1,218 +0,0 @@
-
-=head1 NAME
-
-Pod::Simple - framework for parsing Pod
-
-=head1 SYNOPSIS
-
- TODO
-
-=head1 DESCRIPTION
-
-Pod::Simple is a Perl library for parsing text in the Pod ("plain old
-documentation") markup language that is typically used for writing
-documentation for Perl and for Perl modules. The Pod format is explained
-in the L<perlpod|perlpod> man page; the most common formatter is called
-"perldoc".
-
-Pod formatters can use Pod::Simple to parse Pod documents into produce
-renderings of them in plain ASCII, in HTML, or in any number of other
-formats. Typically, such formatters will be subclasses of Pod::Simple,
-and so they will inherit its methods, like C<parse_file>.
-
-If you're reading this document just because you have a Pod-processing
-subclass that you want to use, this document (plus the documentation for
-the subclass) is probably all you'll need to read.
-
-If you're reading this document because you want to write a formatter
-subclass, continue reading this document, and then read
-L<Pod::Simple::Subclassing>, and then possibly even read L<perlpodspec>
-(some of which is for parser-writers, but much of which is notes to
-formatter-writers).
-
-
-=head1 MAIN METHODS
-
-
-
-=over
-
-=item C<< $parser = I<SomeClass>->new(); >>
-
-This returns a new parser object, where I<C<SomeClass>> is a subclass
-of Pod::Simple.
-
-=item C<< $parser->output_fh( *OUT ); >>
-
-This sets the filehandle that C<$parser>'s output will be written to.
-You can pass C<*STDOUT>, otherwise you should probably do something
-like this:
-
- my $outfile = "output.txt";
- open TXTOUT, ">$outfile" or die "Can't write to $outfile: $!";
- $parser->output_fh(*TXTOUT);
-
-...before you call one of the C<< $parser->parse_I<whatever> >> methods.
-
-=item C<< $parser->output_string( \$somestring ); >>
-
-This sets the string that C<$parser>'s output will be sent to,
-instead of any filehandle.
-
-
-=item C<< $parser->parse_file( I<$some_filename> ); >>
-
-=item C<< $parser->parse_file( *INPUT_FH ); >>
-
-This reads the Pod content of the file (or filehandle) that you specify,
-and processes it with that C<$parser> object, according to however
-C<$parser>'s class works, and according to whatever parser options you
-have set up for this C<$parser> object.
-
-=item C<< $parser->parse_string_document( I<$all_content> ); >>
-
-This works just like C<parse_file> except that it reads the Pod
-content not from a file, but from a string that you have already
-in memory.
-
-=item C<< $parser->parse_lines( I<...@lines...>, undef ); >>
-
-This processes the lines in C<@lines> (where each list item must be a
-defined value, and must contain exactly one line of content -- so no
-items like C<"foo\nbar"> are allowed). The final C<undef> is used to
-indicate the end of document being parsed.
-
-The other C<parser_I<whatever>> methods are meant to be called only once
-per C<$parser> object; but C<parse_lines> can be called as many times per
-C<$parser> object as you want, as long as the last call (and only
-the last call) ends with an C<undef> value.
-
-
-=item C<< $parser->content_seen >>
-
-This returns true only if there has been any real content seen
-for this document.
-
-
-=item C<< I<SomeClass>->filter( I<$filename> ); >>
-
-=item C<< I<SomeClass>->filter( I<*INPUT_FH> ); >>
-
-=item C<< I<SomeClass>->filter( I<\$document_content> ); >>
-
-This is a shortcut method for creating a new parser object, setting the
-output handle to STDOUT, and then processing the specified file (or
-filehandle, or in-memory document). This is handy for one-liners like
-this:
-
- perl -MPod::Simple::Text -e "Pod::Simple::Text->filter('thingy.pod')"
-
-=back
-
-
-
-=head1 SECONDARY METHODS
-
-Some of these methods might be of interest to general users, as
-well as of interest to formatter-writers.
-
-Note that the general pattern here is that the accessor-methods
-read the attribute's value with C<< $value = $parser->I<attribute> >>
-and set the attribute's value with
-C<< $parser->I<attribute>(I<newvalue>) >>. For each accessor, I typically
-only mention one syntax or another, based on which I think you are actually
-most likely to use.
-
-
-=over
-
-=item C<< $parser->no_whining( I<SOMEVALUE> ) >>
-
-If you set this attribute to a true value, you will suppress the
-parser's complaints about irregularities in the Pod coding. By default,
-this attribute's value is false, meaning that irregularities will
-be reported.
-
-Note that turning this attribute to true won't suppress one or two kinds
-of complaints about rarely occurring unrecoverable errors.
-
-
-=item C<< $parser->no_errata_section( I<SOMEVALUE> ) >>
-
-If you set this attribute to a true value, you will stop the parser from
-generating a "POD ERRORS" section at the end of the document. By
-default, this attribute's value is false, meaning that an errata section
-will be generated, as necessary.
-
-
-=item C<< $parser->complain_stderr( I<SOMEVALUE> ) >>
-
-If you set this attribute to a true value, it will send reports of
-parsing errors to STDERR. By default, this attribute's value is false,
-meaning that no output is sent to STDERR.
-
-Note that errors can be noted in an errata section, or sent to STDERR,
-or both, or neither. So don't think that turning on C<complain_stderr>
-will turn off C<no_errata_section> or vice versa -- these are
-independent attributes.
-
-
-=item C<< $parser->source_filename >>
-
-This returns the filename that this parser object was set to read from.
-
-
-=item C<< $parser->doc_has_started >>
-
-This returns true if C<$parser> has read from a source, and has seen
-Pod content in it.
-
-
-=item C<< $parser->source_dead >>
-
-This returns true if C<$parser> has read from a source, and come to the
-end of that source.
-
-=back
-
-
-=head1 CAVEATS
-
-This is just a beta release -- there are a good number of things still
-left to do. Notably, support for EBCDIC platforms is still half-done,
-an untested.
-
-
-=head1 SEE ALSO
-
-L<Pod::Simple::Subclassing>
-
-L<perlpod|perlpod>
-
-L<perlpodspec|perlpodspec>
-
-L<Pod::Escapes|Pod::Escapes>
-
-L<perldoc>
-
-
-=head1 COPYRIGHT AND DISCLAIMERS
-
-Copyright (c) 2002 Sean M. Burke. All rights reserved.
-
-This library 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.
-
-=head1 AUTHOR
-
-Original author: Sean M. Burke C<sburke@cpan.org>
-
-Maintained by: Allison Randal C<allison@perl.org>
-
-=cut
-
-
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Pod/Simple/BlackBox.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Pod/Simple/BlackBox.pm
deleted file mode 100644
index 6d7fdba4fbf..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Pod/Simple/BlackBox.pm
+++ /dev/null
@@ -1,1923 +0,0 @@
-
-package Pod::Simple::BlackBox;
-#
-# "What's in the box?" "Pain."
-#
-###########################################################################
-#
-# This is where all the scary things happen: parsing lines into
-# paragraphs; and then into directives, verbatims, and then also
-# turning formatting sequences into treelets.
-#
-# Are you really sure you want to read this code?
-#
-#-----------------------------------------------------------------------------
-#
-# The basic work of this module Pod::Simple::BlackBox is doing the dirty work
-# of parsing Pod into treelets (generally one per non-verbatim paragraph), and
-# to call the proper callbacks on the treelets.
-#
-# Every node in a treelet is a ['name', {attrhash}, ...children...]
-
-use integer; # vroom!
-use strict;
-use Carp ();
-BEGIN {
- require Pod::Simple;
- *DEBUG = \&Pod::Simple::DEBUG unless defined &DEBUG
-}
-
-#@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
-
-sub parse_line { shift->parse_lines(@_) } # alias
-
-# - - - Turn back now! Run away! - - -
-
-sub parse_lines { # Usage: $parser->parse_lines(@lines)
- # an undef means end-of-stream
- my $self = shift;
-
- my $code_handler = $self->{'code_handler'};
- my $cut_handler = $self->{'cut_handler'};
- $self->{'line_count'} ||= 0;
-
- my $scratch;
-
- DEBUG > 4 and
- print "# Parsing starting at line ", $self->{'line_count'}, ".\n";
-
- DEBUG > 5 and
- print "# About to parse lines: ",
- join(' ', map defined($_) ? "[$_]" : "EOF", @_), "\n";
-
- my $paras = ($self->{'paras'} ||= []);
- # paragraph buffer. Because we need to defer processing of =over
- # directives and verbatim paragraphs. We call _ponder_paragraph_buffer
- # to process this.
-
- $self->{'pod_para_count'} ||= 0;
-
- my $line;
- foreach my $source_line (@_) {
- if( $self->{'source_dead'} ) {
- DEBUG > 4 and print "# Source is dead.\n";
- last;
- }
-
- unless( defined $source_line ) {
- DEBUG > 4 and print "# Undef-line seen.\n";
-
- push @$paras, ['~end', {'start_line' => $self->{'line_count'}}];
- push @$paras, $paras->[-1], $paras->[-1];
- # So that it definitely fills the buffer.
- $self->{'source_dead'} = 1;
- $self->_ponder_paragraph_buffer;
- next;
- }
-
-
- if( $self->{'line_count'}++ ) {
- ($line = $source_line) =~ tr/\n\r//d;
- # If we don't have two vars, we'll end up with that there
- # tr/// modding the (potentially read-only) original source line!
-
- } else {
- DEBUG > 2 and print "First line: [$source_line]\n";
-
- if( ($line = $source_line) =~ s/^\xEF\xBB\xBF//s ) {
- DEBUG and print "UTF-8 BOM seen. Faking a '=encode utf8'.\n";
- $self->_handle_encoding_line( "=encode utf8" );
- $line =~ tr/\n\r//d;
-
- } elsif( $line =~ s/^\xFE\xFF//s ) {
- DEBUG and print "Big-endian UTF-16 BOM seen. Aborting parsing.\n";
- $self->scream(
- $self->{'line_count'},
- "UTF16-BE Byte Encoding Mark found; but Pod::Simple v$Pod::Simple::VERSION doesn't implement UTF16 yet."
- );
- splice @_;
- push @_, undef;
- next;
-
- # TODO: implement somehow?
-
- } elsif( $line =~ s/^\xFF\xFE//s ) {
- DEBUG and print "Little-endian UTF-16 BOM seen. Aborting parsing.\n";
- $self->scream(
- $self->{'line_count'},
- "UTF16-LE Byte Encoding Mark found; but Pod::Simple v$Pod::Simple::VERSION doesn't implement UTF16 yet."
- );
- splice @_;
- push @_, undef;
- next;
-
- # TODO: implement somehow?
-
- } else {
- DEBUG > 2 and print "First line is BOM-less.\n";
- ($line = $source_line) =~ tr/\n\r//d;
- }
- }
-
-
- DEBUG > 5 and print "# Parsing line: [$line]\n";
-
- if(!$self->{'in_pod'}) {
- if($line =~ m/^=([a-zA-Z]+)/s) {
- if($1 eq 'cut') {
- $self->scream(
- $self->{'line_count'},
- "=cut found outside a pod block. Skipping to next block."
- );
-
- ## Before there were errata sections in the world, it was
- ## least-pessimal to abort processing the file. But now we can
- ## just barrel on thru (but still not start a pod block).
- #splice @_;
- #push @_, undef;
-
- next;
- } else {
- $self->{'in_pod'} = $self->{'start_of_pod_block'}
- = $self->{'last_was_blank'} = 1;
- # And fall thru to the pod-mode block further down
- }
- } else {
- DEBUG > 5 and print "# It's a code-line.\n";
- $code_handler->(map $_, $line, $self->{'line_count'}, $self)
- if $code_handler;
- # Note: this may cause code to be processed out of order relative
- # to pods, but in order relative to cuts.
-
- # Note also that we haven't yet applied the transcoding to $line
- # by time we call $code_handler!
-
- if( $line =~ m/^#\s*line\s+(\d+)\s*(?:\s"([^"]+)")?\s*$/ ) {
- # That RE is from perlsyn, section "Plain Old Comments (Not!)",
- #$fname = $2 if defined $2;
- #DEBUG > 1 and defined $2 and print "# Setting fname to \"$fname\"\n";
- DEBUG > 1 and print "# Setting nextline to $1\n";
- $self->{'line_count'} = $1 - 1;
- }
-
- next;
- }
- }
-
- # . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
- # Else we're in pod mode:
-
- # Apply any necessary transcoding:
- $self->{'_transcoder'} && $self->{'_transcoder'}->($line);
-
- # HERE WE CATCH =encoding EARLY!
- if( $line =~ m/^=encoding\s+\S+\s*$/s ) {
- $line = $self->_handle_encoding_line( $line );
- }
-
- if($line =~ m/^=cut/s) {
- # here ends the pod block, and therefore the previous pod para
- DEBUG > 1 and print "Noting =cut at line ${$self}{'line_count'}\n";
- $self->{'in_pod'} = 0;
- # ++$self->{'pod_para_count'};
- $self->_ponder_paragraph_buffer();
- # by now it's safe to consider the previous paragraph as done.
- $cut_handler->(map $_, $line, $self->{'line_count'}, $self)
- if $cut_handler;
-
- # TODO: add to docs: Note: this may cause cuts to be processed out
- # of order relative to pods, but in order relative to code.
-
- } elsif($line =~ m/^\s*$/s) { # it's a blank line
- if(!$self->{'start_of_pod_block'} and @$paras and $paras->[-1][0] eq '~Verbatim') {
- DEBUG > 1 and print "Saving blank line at line ${$self}{'line_count'}\n";
- push @{$paras->[-1]}, $line;
- } # otherwise it's not interesting
-
- if(!$self->{'start_of_pod_block'} and !$self->{'last_was_blank'}) {
- DEBUG > 1 and print "Noting para ends with blank line at ${$self}{'line_count'}\n";
- }
-
- $self->{'last_was_blank'} = 1;
-
- } elsif($self->{'last_was_blank'}) { # A non-blank line starting a new para...
-
- if($line =~ m/^(=[a-zA-Z][a-zA-Z0-9]*)(?:\s+|$)(.*)/s) {
- # THIS IS THE ONE PLACE WHERE WE CONSTRUCT NEW DIRECTIVE OBJECTS
- my $new = [$1, {'start_line' => $self->{'line_count'}}, $2];
- # Note that in "=head1 foo", the WS is lost.
- # Example: ['=head1', {'start_line' => 123}, ' foo']
-
- ++$self->{'pod_para_count'};
-
- $self->_ponder_paragraph_buffer();
- # by now it's safe to consider the previous paragraph as done.
-
- push @$paras, $new; # the new incipient paragraph
- DEBUG > 1 and print "Starting new ${$paras}[-1][0] para at line ${$self}{'line_count'}\n";
-
- } elsif($line =~ m/^\s/s) {
-
- if(!$self->{'start_of_pod_block'} and @$paras and $paras->[-1][0] eq '~Verbatim') {
- DEBUG > 1 and print "Resuming verbatim para at line ${$self}{'line_count'}\n";
- push @{$paras->[-1]}, $line;
- } else {
- ++$self->{'pod_para_count'};
- $self->_ponder_paragraph_buffer();
- # by now it's safe to consider the previous paragraph as done.
- DEBUG > 1 and print "Starting verbatim para at line ${$self}{'line_count'}\n";
- push @$paras, ['~Verbatim', {'start_line' => $self->{'line_count'}}, $line];
- }
- } else {
- ++$self->{'pod_para_count'};
- $self->_ponder_paragraph_buffer();
- # by now it's safe to consider the previous paragraph as done.
- push @$paras, ['~Para', {'start_line' => $self->{'line_count'}}, $line];
- DEBUG > 1 and print "Starting plain para at line ${$self}{'line_count'}\n";
- }
- $self->{'last_was_blank'} = $self->{'start_of_pod_block'} = 0;
-
- } else {
- # It's a non-blank line /continuing/ the current para
- if(@$paras) {
- DEBUG > 2 and print "Line ${$self}{'line_count'} continues current paragraph\n";
- push @{$paras->[-1]}, $line;
- } else {
- # Unexpected case!
- die "Continuing a paragraph but \@\$paras is empty?";
- }
- $self->{'last_was_blank'} = $self->{'start_of_pod_block'} = 0;
- }
-
- } # ends the big while loop
-
- DEBUG > 1 and print(pretty(@$paras), "\n");
- return $self;
-}
-
-#@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
-
-sub _handle_encoding_line {
- my($self, $line) = @_;
-
- # The point of this routine is to set $self->{'_transcoder'} as indicated.
-
- return $line unless $line =~ m/^=encoding\s+(\S+)\s*$/s;
- DEBUG > 1 and print "Found an encoding line \"=encoding $1\"\n";
-
- my $e = $1;
- my $orig = $e;
- push @{ $self->{'encoding_command_reqs'} }, "=encoding $orig";
-
- my $enc_error;
-
- # Cf. perldoc Encode and perldoc Encode::Supported
-
- require Pod::Simple::Transcode;
-
- if( $self->{'encoding'} ) {
- my $norm_current = $self->{'encoding'};
- my $norm_e = $e;
- foreach my $that ($norm_current, $norm_e) {
- $that = lc($that);
- $that =~ s/[-_]//g;
- }
- if($norm_current eq $norm_e) {
- DEBUG > 1 and print "The '=encoding $orig' line is ",
- "redundant. ($norm_current eq $norm_e). Ignoring.\n";
- $enc_error = '';
- # But that doesn't necessarily mean that the earlier one went okay
- } else {
- $enc_error = "Encoding is already set to " . $self->{'encoding'};
- DEBUG > 1 and print $enc_error;
- }
- } elsif (
- # OK, let's turn on the encoding
- do {
- DEBUG > 1 and print " Setting encoding to $e\n";
- $self->{'encoding'} = $e;
- 1;
- }
- and $e eq 'HACKRAW'
- ) {
- DEBUG and print " Putting in HACKRAW (no-op) encoding mode.\n";
-
- } elsif( Pod::Simple::Transcode::->encoding_is_available($e) ) {
-
- die($enc_error = "WHAT? _transcoder is already set?!")
- if $self->{'_transcoder'}; # should never happen
- require Pod::Simple::Transcode;
- $self->{'_transcoder'} = Pod::Simple::Transcode::->make_transcoder($e);
- eval {
- my @x = ('', "abc", "123");
- $self->{'_transcoder'}->(@x);
- };
- $@ && die( $enc_error =
- "Really unexpected error setting up encoding $e: $@\nAborting"
- );
-
- } else {
- my @supported = Pod::Simple::Transcode::->all_encodings;
-
- # Note unsupported, and complain
- DEBUG and print " Encoding [$e] is unsupported.",
- "\nSupporteds: @supported\n";
- my $suggestion = '';
-
- # Look for a near match:
- my $norm = lc($e);
- $norm =~ tr[-_][]d;
- my $n;
- foreach my $enc (@supported) {
- $n = lc($enc);
- $n =~ tr[-_][]d;
- next unless $n eq $norm;
- $suggestion = " (Maybe \"$e\" should be \"$enc\"?)";
- last;
- }
- my $encmodver = Pod::Simple::Transcode::->encmodver;
- $enc_error = join '' =>
- "This document probably does not appear as it should, because its ",
- "\"=encoding $e\" line calls for an unsupported encoding.",
- $suggestion, " [$encmodver\'s supported encodings are: @supported]"
- ;
-
- $self->scream( $self->{'line_count'}, $enc_error );
- }
- push @{ $self->{'encoding_command_statuses'} }, $enc_error;
-
- return '=encoding ALREADYDONE';
-}
-
-# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-
-sub _handle_encoding_second_level {
- # By time this is called, the encoding (if well formed) will already
- # have been acted one.
- my($self, $para) = @_;
- my @x = @$para;
- my $content = join ' ', splice @x, 2;
- $content =~ s/^\s+//s;
- $content =~ s/\s+$//s;
-
- DEBUG > 2 and print "Ogling encoding directive: =encoding $content\n";
-
- if($content eq 'ALREADYDONE') {
- # It's already been handled. Check for errors.
- if(! $self->{'encoding_command_statuses'} ) {
- DEBUG > 2 and print " CRAZY ERROR: It wasn't really handled?!\n";
- } elsif( $self->{'encoding_command_statuses'}[-1] ) {
- $self->whine( $para->[1]{'start_line'},
- sprintf "Couldn't do %s: %s",
- $self->{'encoding_command_reqs' }[-1],
- $self->{'encoding_command_statuses'}[-1],
- );
- } else {
- DEBUG > 2 and print " (Yup, it was successfully handled already.)\n";
- }
-
- } else {
- # Otherwise it's a syntax error
- $self->whine( $para->[1]{'start_line'},
- "Invalid =encoding syntax: $content"
- );
- }
-
- return;
-}
-
-#~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`
-
-{
-my $m = -321; # magic line number
-
-sub _gen_errata {
- my $self = $_[0];
- # Return 0 or more fake-o paragraphs explaining the accumulated
- # errors on this document.
-
- return() unless $self->{'errata'} and keys %{$self->{'errata'}};
-
- my @out;
-
- foreach my $line (sort {$a <=> $b} keys %{$self->{'errata'}}) {
- push @out,
- ['=item', {'start_line' => $m}, "Around line $line:"],
- map( ['~Para', {'start_line' => $m, '~cooked' => 1},
- #['~Top', {'start_line' => $m},
- $_
- #]
- ],
- @{$self->{'errata'}{$line}}
- )
- ;
- }
-
- # TODO: report of unknown entities? unrenderable characters?
-
- unshift @out,
- ['=head1', {'start_line' => $m, 'errata' => 1}, 'POD ERRORS'],
- ['~Para', {'start_line' => $m, '~cooked' => 1, 'errata' => 1},
- "Hey! ",
- ['B', {},
- 'The above document had some coding errors, which are explained below:'
- ]
- ],
- ['=over', {'start_line' => $m, 'errata' => 1}, ''],
- ;
-
- push @out,
- ['=back', {'start_line' => $m, 'errata' => 1}, ''],
- ;
-
- DEBUG and print "\n<<\n", pretty(\@out), "\n>>\n\n";
-
- return @out;
-}
-
-}
-
-#@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
-
-##############################################################################
-##
-## stop reading now stop reading now stop reading now stop reading now stop
-##
-## HERE IT BECOMES REALLY SCARY
-##
-## stop reading now stop reading now stop reading now stop reading now stop
-##
-##############################################################################
-
-sub _ponder_paragraph_buffer {
-
- # Para-token types as found in the buffer.
- # ~Verbatim, ~Para, ~end, =head1..4, =for, =begin, =end,
- # =over, =back, =item
- # and the null =pod (to be complained about if over one line)
- #
- # "~data" paragraphs are something we generate at this level, depending on
- # a currently open =over region
-
- # Events fired: Begin and end for:
- # directivename (like head1 .. head4), item, extend,
- # for (from =begin...=end, =for),
- # over-bullet, over-number, over-text, over-block,
- # item-bullet, item-number, item-text,
- # Document,
- # Data, Para, Verbatim
- # B, C, longdirname (TODO -- wha?), etc. for all directives
- #
-
- my $self = $_[0];
- my $paras;
- return unless @{$paras = $self->{'paras'}};
- my $curr_open = ($self->{'curr_open'} ||= []);
-
- my $scratch;
-
- DEBUG > 10 and print "# Paragraph buffer: <<", pretty($paras), ">>\n";
-
- # We have something in our buffer. So apparently the document has started.
- unless($self->{'doc_has_started'}) {
- $self->{'doc_has_started'} = 1;
-
- my $starting_contentless;
- $starting_contentless =
- (
- !@$curr_open
- and @$paras and ! grep $_->[0] ne '~end', @$paras
- # i.e., if the paras is all ~ends
- )
- ;
- DEBUG and print "# Starting ",
- $starting_contentless ? 'contentless' : 'contentful',
- " document\n"
- ;
-
- $self->_handle_element_start(
- ($scratch = 'Document'),
- {
- 'start_line' => $paras->[0][1]{'start_line'},
- $starting_contentless ? ( 'contentless' => 1 ) : (),
- },
- );
- }
-
- my($para, $para_type);
- while(@$paras) {
- last if @$paras == 1 and
- ( $paras->[0][0] eq '=over' or $paras->[0][0] eq '~Verbatim'
- or $paras->[0][0] eq '=item' )
- ;
- # Those're the three kinds of paragraphs that require lookahead.
- # Actually, an "=item Foo" inside an <over type=text> region
- # and any =item inside an <over type=block> region (rare)
- # don't require any lookahead, but all others (bullets
- # and numbers) do.
-
-# TODO: winge about many kinds of directives in non-resolving =for regions?
-# TODO: many? like what? =head1 etc?
-
- $para = shift @$paras;
- $para_type = $para->[0];
-
- DEBUG > 1 and print "Pondering a $para_type paragraph, given the stack: (",
- $self->_dump_curr_open(), ")\n";
-
- if($para_type eq '=for') {
- next if $self->_ponder_for($para,$curr_open,$paras);
-
- } elsif($para_type eq '=begin') {
- next if $self->_ponder_begin($para,$curr_open,$paras);
-
- } elsif($para_type eq '=end') {
- next if $self->_ponder_end($para,$curr_open,$paras);
-
- } elsif($para_type eq '~end') { # The virtual end-document signal
- next if $self->_ponder_doc_end($para,$curr_open,$paras);
- }
-
-
- # ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
- #~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
- if(grep $_->[1]{'~ignore'}, @$curr_open) {
- DEBUG > 1 and
- print "Skipping $para_type paragraph because in ignore mode.\n";
- next;
- }
- #~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
- # ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
-
- if($para_type eq '=pod') {
- $self->_ponder_pod($para,$curr_open,$paras);
-
- } elsif($para_type eq '=over') {
- next if $self->_ponder_over($para,$curr_open,$paras);
-
- } elsif($para_type eq '=back') {
- next if $self->_ponder_back($para,$curr_open,$paras);
-
- } else {
-
- # All non-magical codes!!!
-
- # Here we start using $para_type for our own twisted purposes, to
- # mean how it should get treated, not as what the element name
- # should be.
-
- DEBUG > 1 and print "Pondering non-magical $para_type\n";
-
- my $i;
-
- # Enforce some =headN discipline
- if($para_type =~ m/^=head\d$/s
- and ! $self->{'accept_heads_anywhere'}
- and @$curr_open
- and $curr_open->[-1][0] eq '=over'
- ) {
- DEBUG > 2 and print "'=$para_type' inside an '=over'!\n";
- $self->whine(
- $para->[1]{'start_line'},
- "You forgot a '=back' before '$para_type'"
- );
- unshift @$paras, ['=back', {}, ''], $para; # close the =over
- next;
- }
-
-
- if($para_type eq '=item') {
-
- my $over;
- unless(@$curr_open and ($over = $curr_open->[-1])->[0] eq '=over') {
- $self->whine(
- $para->[1]{'start_line'},
- "'=item' outside of any '=over'"
- );
- unshift @$paras,
- ['=over', {'start_line' => $para->[1]{'start_line'}}, ''],
- $para
- ;
- next;
- }
-
-
- my $over_type = $over->[1]{'~type'};
-
- if(!$over_type) {
- # Shouldn't happen1
- die "Typeless over in stack, starting at line "
- . $over->[1]{'start_line'};
-
- } elsif($over_type eq 'block') {
- unless($curr_open->[-1][1]{'~bitched_about'}) {
- $curr_open->[-1][1]{'~bitched_about'} = 1;
- $self->whine(
- $curr_open->[-1][1]{'start_line'},
- "You can't have =items (as at line "
- . $para->[1]{'start_line'}
- . ") unless the first thing after the =over is an =item"
- );
- }
- # Just turn it into a paragraph and reconsider it
- $para->[0] = '~Para';
- unshift @$paras, $para;
- next;
-
- } elsif($over_type eq 'text') {
- my $item_type = $self->_get_item_type($para);
- # That kills the content of the item if it's a number or bullet.
- DEBUG and print " Item is of type ", $para->[0], " under $over_type\n";
-
- if($item_type eq 'text') {
- # Nothing special needs doing for 'text'
- } elsif($item_type eq 'number' or $item_type eq 'bullet') {
- die "Unknown item type $item_type"
- unless $item_type eq 'number' or $item_type eq 'bullet';
- # Undo our clobbering:
- push @$para, $para->[1]{'~orig_content'};
- delete $para->[1]{'number'};
- # Only a PROPER item-number element is allowed
- # to have a number attribute.
- } else {
- die "Unhandled item type $item_type"; # should never happen
- }
-
- # =item-text thingies don't need any assimilation, it seems.
-
- } elsif($over_type eq 'number') {
- my $item_type = $self->_get_item_type($para);
- # That kills the content of the item if it's a number or bullet.
- DEBUG and print " Item is of type ", $para->[0], " under $over_type\n";
-
- my $expected_value = ++ $curr_open->[-1][1]{'~counter'};
-
- if($item_type eq 'bullet') {
- # Hm, it's not numeric. Correct for this.
- $para->[1]{'number'} = $expected_value;
- $self->whine(
- $para->[1]{'start_line'},
- "Expected '=item $expected_value'"
- );
- push @$para, $para->[1]{'~orig_content'};
- # restore the bullet, blocking the assimilation of next para
-
- } elsif($item_type eq 'text') {
- # Hm, it's not numeric. Correct for this.
- $para->[1]{'number'} = $expected_value;
- $self->whine(
- $para->[1]{'start_line'},
- "Expected '=item $expected_value'"
- );
- # Text content will still be there and will block next ~Para
-
- } elsif($item_type ne 'number') {
- die "Unknown item type $item_type"; # should never happen
-
- } elsif($expected_value == $para->[1]{'number'}) {
- DEBUG > 1 and print " Numeric item has the expected value of $expected_value\n";
-
- } else {
- DEBUG > 1 and print " Numeric item has ", $para->[1]{'number'},
- " instead of the expected value of $expected_value\n";
- $self->whine(
- $para->[1]{'start_line'},
- "You have '=item " . $para->[1]{'number'} .
- "' instead of the expected '=item $expected_value'"
- );
- $para->[1]{'number'} = $expected_value; # correcting!!
- }
-
- if(@$para == 2) {
- # For the cases where we /didn't/ push to @$para
- if($paras->[0][0] eq '~Para') {
- DEBUG and print "Assimilating following ~Para content into $over_type item\n";
- push @$para, splice @{shift @$paras},2;
- } else {
- DEBUG and print "Can't assimilate following ", $paras->[0][0], "\n";
- push @$para, ''; # Just so it's not contentless
- }
- }
-
-
- } elsif($over_type eq 'bullet') {
- my $item_type = $self->_get_item_type($para);
- # That kills the content of the item if it's a number or bullet.
- DEBUG and print " Item is of type ", $para->[0], " under $over_type\n";
-
- if($item_type eq 'bullet') {
- # as expected!
-
- if( $para->[1]{'~_freaky_para_hack'} ) {
- DEBUG and print "Accomodating '=item * Foo' tolerance hack.\n";
- push @$para, delete $para->[1]{'~_freaky_para_hack'};
- }
-
- } elsif($item_type eq 'number') {
- $self->whine(
- $para->[1]{'start_line'},
- "Expected '=item *'"
- );
- push @$para, $para->[1]{'~orig_content'};
- # and block assimilation of the next paragraph
- delete $para->[1]{'number'};
- # Only a PROPER item-number element is allowed
- # to have a number attribute.
- } elsif($item_type eq 'text') {
- $self->whine(
- $para->[1]{'start_line'},
- "Expected '=item *'"
- );
- # But doesn't need processing. But it'll block assimilation
- # of the next para.
- } else {
- die "Unhandled item type $item_type"; # should never happen
- }
-
- if(@$para == 2) {
- # For the cases where we /didn't/ push to @$para
- if($paras->[0][0] eq '~Para') {
- DEBUG and print "Assimilating following ~Para content into $over_type item\n";
- push @$para, splice @{shift @$paras},2;
- } else {
- DEBUG and print "Can't assimilate following ", $paras->[0][0], "\n";
- push @$para, ''; # Just so it's not contentless
- }
- }
-
- } else {
- die "Unhandled =over type \"$over_type\"?";
- # Shouldn't happen!
- }
-
- $para_type = 'Plain';
- $para->[0] .= '-' . $over_type;
- # Whew. Now fall thru and process it.
-
-
- } elsif($para_type eq '=extend') {
- # Well, might as well implement it here.
- $self->_ponder_extend($para);
- next; # and skip
- } elsif($para_type eq '=encoding') {
- # Not actually acted on here, but we catch errors here.
- $self->_handle_encoding_second_level($para);
-
- next; # and skip
- } elsif($para_type eq '~Verbatim') {
- $para->[0] = 'Verbatim';
- $para_type = '?Verbatim';
- } elsif($para_type eq '~Para') {
- $para->[0] = 'Para';
- $para_type = '?Plain';
- } elsif($para_type eq 'Data') {
- $para->[0] = 'Data';
- $para_type = '?Data';
- } elsif( $para_type =~ s/^=//s
- and defined( $para_type = $self->{'accept_directives'}{$para_type} )
- ) {
- DEBUG > 1 and print " Pondering known directive ${$para}[0] as $para_type\n";
- } else {
- # An unknown directive!
- DEBUG > 1 and printf "Unhandled directive %s (Handled: %s)\n",
- $para->[0], join(' ', sort keys %{$self->{'accept_directives'}} )
- ;
- $self->whine(
- $para->[1]{'start_line'},
- "Unknown directive: $para->[0]"
- );
-
- # And maybe treat it as text instead of just letting it go?
- next;
- }
-
- if($para_type =~ s/^\?//s) {
- if(! @$curr_open) { # usual case
- DEBUG and print "Treating $para_type paragraph as such because stack is empty.\n";
- } else {
- my @fors = grep $_->[0] eq '=for', @$curr_open;
- DEBUG > 1 and print "Containing fors: ",
- join(',', map $_->[1]{'target'}, @fors), "\n";
-
- if(! @fors) {
- DEBUG and print "Treating $para_type paragraph as such because stack has no =for's\n";
-
- #} elsif(grep $_->[1]{'~resolve'}, @fors) {
- #} elsif(not grep !$_->[1]{'~resolve'}, @fors) {
- } elsif( $fors[-1][1]{'~resolve'} ) {
- # Look to the immediately containing for
-
- if($para_type eq 'Data') {
- DEBUG and print "Treating Data paragraph as Plain/Verbatim because the containing =for ($fors[-1][1]{'target'}) is a resolver\n";
- $para->[0] = 'Para';
- $para_type = 'Plain';
- } else {
- DEBUG and print "Treating $para_type paragraph as such because the containing =for ($fors[-1][1]{'target'}) is a resolver\n";
- }
- } else {
- DEBUG and print "Treating $para_type paragraph as Data because the containing =for ($fors[-1][1]{'target'}) is a non-resolver\n";
- $para->[0] = $para_type = 'Data';
- }
- }
- }
-
- #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- if($para_type eq 'Plain') {
- $self->_ponder_Plain($para);
- } elsif($para_type eq 'Verbatim') {
- $self->_ponder_Verbatim($para);
- } elsif($para_type eq 'Data') {
- $self->_ponder_Data($para);
- } else {
- die "\$para type is $para_type -- how did that happen?";
- # Shouldn't happen.
- }
-
- #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- $para->[0] =~ s/^[~=]//s;
-
- DEBUG and print "\n", pretty($para), "\n";
-
- # traverse the treelet (which might well be just one string scalar)
- $self->{'content_seen'} ||= 1;
- $self->_traverse_treelet_bit(@$para);
- }
- }
-
- return;
-}
-
-###########################################################################
-# The sub-ponderers...
-
-
-
-sub _ponder_for {
- my ($self,$para,$curr_open,$paras) = @_;
-
- # Fake it out as a begin/end
- my $target;
-
- if(grep $_->[1]{'~ignore'}, @$curr_open) {
- DEBUG > 1 and print "Ignoring ignorable =for\n";
- return 1;
- }
-
- for(my $i = 2; $i < @$para; ++$i) {
- if($para->[$i] =~ s/^\s*(\S+)\s*//s) {
- $target = $1;
- last;
- }
- }
- unless(defined $target) {
- $self->whine(
- $para->[1]{'start_line'},
- "=for without a target?"
- );
- return 1;
- }
- DEBUG > 1 and
- print "Faking out a =for $target as a =begin $target / =end $target\n";
-
- $para->[0] = 'Data';
-
- unshift @$paras,
- ['=begin',
- {'start_line' => $para->[1]{'start_line'}, '~really' => '=for'},
- $target,
- ],
- $para,
- ['=end',
- {'start_line' => $para->[1]{'start_line'}, '~really' => '=for'},
- $target,
- ],
- ;
-
- return 1;
-}
-
-sub _ponder_begin {
- my ($self,$para,$curr_open,$paras) = @_;
- my $content = join ' ', splice @$para, 2;
- $content =~ s/^\s+//s;
- $content =~ s/\s+$//s;
- unless(length($content)) {
- $self->whine(
- $para->[1]{'start_line'},
- "=begin without a target?"
- );
- DEBUG and print "Ignoring targetless =begin\n";
- return 1;
- }
-
- unless($content =~ m/^\S+$/s) { # i.e., unless it's one word
- $self->whine(
- $para->[1]{'start_line'},
- "'=begin' only takes one parameter, not several as in '=begin $content'"
- );
- DEBUG and print "Ignoring unintelligible =begin $content\n";
- return 1;
- }
-
-
- $para->[1]{'target'} = $content; # without any ':'
-
- $content =~ s/^:!/!:/s;
- my $neg; # whether this is a negation-match
- $neg = 1 if $content =~ s/^!//s;
- my $to_resolve; # whether to process formatting codes
- $to_resolve = 1 if $content =~ s/^://s;
-
- my $dont_ignore; # whether this target matches us
-
- foreach my $target_name (
- split(',', $content, -1),
- $neg ? () : '*'
- ) {
- DEBUG > 2 and
- print " Considering whether =begin $content matches $target_name\n";
- next unless $self->{'accept_targets'}{$target_name};
-
- DEBUG > 2 and
- print " It DOES match the acceptable target $target_name!\n";
- $to_resolve = 1
- if $self->{'accept_targets'}{$target_name} eq 'force_resolve';
- $dont_ignore = 1;
- $para->[1]{'target_matching'} = $target_name;
- last; # stop looking at other target names
- }
-
- if($neg) {
- if( $dont_ignore ) {
- $dont_ignore = '';
- delete $para->[1]{'target_matching'};
- DEBUG > 2 and print " But the leading ! means that this is a NON-match!\n";
- } else {
- $dont_ignore = 1;
- $para->[1]{'target_matching'} = '!';
- DEBUG > 2 and print " But the leading ! means that this IS a match!\n";
- }
- }
-
- $para->[0] = '=for'; # Just what we happen to call these, internally
- $para->[1]{'~really'} ||= '=begin';
- $para->[1]{'~ignore'} = (! $dont_ignore) || 0;
- $para->[1]{'~resolve'} = $to_resolve || 0;
-
- DEBUG > 1 and print " Making note to ", $dont_ignore ? 'not ' : '',
- "ignore contents of this region\n";
- DEBUG > 1 and $dont_ignore and print " Making note to treat contents as ",
- ($to_resolve ? 'verbatim/plain' : 'data'), " paragraphs\n";
- DEBUG > 1 and print " (Stack now: ", $self->_dump_curr_open(), ")\n";
-
- push @$curr_open, $para;
- if(!$dont_ignore or scalar grep $_->[1]{'~ignore'}, @$curr_open) {
- DEBUG > 1 and print "Ignoring ignorable =begin\n";
- } else {
- $self->{'content_seen'} ||= 1;
- $self->_handle_element_start((my $scratch='for'), $para->[1]);
- }
-
- return 1;
-}
-
-sub _ponder_end {
- my ($self,$para,$curr_open,$paras) = @_;
- my $content = join ' ', splice @$para, 2;
- $content =~ s/^\s+//s;
- $content =~ s/\s+$//s;
- DEBUG and print "Ogling '=end $content' directive\n";
-
- unless(length($content)) {
- $self->whine(
- $para->[1]{'start_line'},
- "'=end' without a target?" . (
- ( @$curr_open and $curr_open->[-1][0] eq '=for' )
- ? ( " (Should be \"=end " . $curr_open->[-1][1]{'target'} . '")' )
- : ''
- )
- );
- DEBUG and print "Ignoring targetless =end\n";
- return 1;
- }
-
- unless($content =~ m/^\S+$/) { # i.e., unless it's one word
- $self->whine(
- $para->[1]{'start_line'},
- "'=end $content' is invalid. (Stack: "
- . $self->_dump_curr_open() . ')'
- );
- DEBUG and print "Ignoring mistargetted =end $content\n";
- return 1;
- }
-
- unless(@$curr_open and $curr_open->[-1][0] eq '=for') {
- $self->whine(
- $para->[1]{'start_line'},
- "=end $content without matching =begin. (Stack: "
- . $self->_dump_curr_open() . ')'
- );
- DEBUG and print "Ignoring mistargetted =end $content\n";
- return 1;
- }
-
- unless($content eq $curr_open->[-1][1]{'target'}) {
- $self->whine(
- $para->[1]{'start_line'},
- "=end $content doesn't match =begin "
- . $curr_open->[-1][1]{'target'}
- . ". (Stack: "
- . $self->_dump_curr_open() . ')'
- );
- DEBUG and print "Ignoring mistargetted =end $content at line $para->[1]{'start_line'}\n";
- return 1;
- }
-
- # Else it's okay to close...
- if(grep $_->[1]{'~ignore'}, @$curr_open) {
- DEBUG > 1 and print "Not firing any event for this =end $content because in an ignored region\n";
- # And that may be because of this to-be-closed =for region, or some
- # other one, but it doesn't matter.
- } else {
- $curr_open->[-1][1]{'start_line'} = $para->[1]{'start_line'};
- # what's that for?
-
- $self->{'content_seen'} ||= 1;
- $self->_handle_element_end( my $scratch = 'for' );
- }
- DEBUG > 1 and print "Popping $curr_open->[-1][0] $curr_open->[-1][1]{'target'} because of =end $content\n";
- pop @$curr_open;
-
- return 1;
-}
-
-sub _ponder_doc_end {
- my ($self,$para,$curr_open,$paras) = @_;
- if(@$curr_open) { # Deal with things left open
- DEBUG and print "Stack is nonempty at end-document: (",
- $self->_dump_curr_open(), ")\n";
-
- DEBUG > 9 and print "Stack: ", pretty($curr_open), "\n";
- unshift @$paras, $self->_closers_for_all_curr_open;
- # Make sure there is exactly one ~end in the parastack, at the end:
- @$paras = grep $_->[0] ne '~end', @$paras;
- push @$paras, $para, $para;
- # We need two -- once for the next cycle where we
- # generate errata, and then another to be at the end
- # when that loop back around to process the errata.
- return 1;
-
- } else {
- DEBUG and print "Okay, stack is empty now.\n";
- }
-
- # Try generating errata section, if applicable
- unless($self->{'~tried_gen_errata'}) {
- $self->{'~tried_gen_errata'} = 1;
- my @extras = $self->_gen_errata();
- if(@extras) {
- unshift @$paras, @extras;
- DEBUG and print "Generated errata... relooping...\n";
- return 1; # I.e., loop around again to process these fake-o paragraphs
- }
- }
-
- splice @$paras; # Well, that's that for this paragraph buffer.
- DEBUG and print "Throwing end-document event.\n";
-
- $self->_handle_element_end( my $scratch = 'Document' );
- return 1; # Hasta la byebye
-}
-
-sub _ponder_pod {
- my ($self,$para,$curr_open,$paras) = @_;
- $self->whine(
- $para->[1]{'start_line'},
- "=pod directives shouldn't be over one line long! Ignoring all "
- . (@$para - 2) . " lines of content"
- ) if @$para > 3;
- # Content is always ignored.
- return;
-}
-
-sub _ponder_over {
- my ($self,$para,$curr_open,$paras) = @_;
- return 1 unless @$paras;
- my $list_type;
-
- if($paras->[0][0] eq '=item') { # most common case
- $list_type = $self->_get_initial_item_type($paras->[0]);
-
- } elsif($paras->[0][0] eq '=back') {
- # Ignore empty lists. TODO: make this an option?
- shift @$paras;
- return 1;
-
- } elsif($paras->[0][0] eq '~end') {
- $self->whine(
- $para->[1]{'start_line'},
- "=over is the last thing in the document?!"
- );
- return 1; # But feh, ignore it.
- } else {
- $list_type = 'block';
- }
- $para->[1]{'~type'} = $list_type;
- push @$curr_open, $para;
- # yes, we reuse the paragraph as a stack item
-
- my $content = join ' ', splice @$para, 2;
- my $overness;
- if($content =~ m/^\s*$/s) {
- $para->[1]{'indent'} = 4;
- } elsif($content =~ m/^\s*((?:\d*\.)?\d+)\s*$/s) {
- no integer;
- $para->[1]{'indent'} = $1;
- if($1 == 0) {
- $self->whine(
- $para->[1]{'start_line'},
- "Can't have a 0 in =over $content"
- );
- $para->[1]{'indent'} = 4;
- }
- } else {
- $self->whine(
- $para->[1]{'start_line'},
- "=over should be: '=over' or '=over positive_number'"
- );
- $para->[1]{'indent'} = 4;
- }
- DEBUG > 1 and print "=over found of type $list_type\n";
-
- $self->{'content_seen'} ||= 1;
- $self->_handle_element_start((my $scratch = 'over-' . $list_type), $para->[1]);
-
- return;
-}
-
-sub _ponder_back {
- my ($self,$para,$curr_open,$paras) = @_;
- # TODO: fire off </item-number> or </item-bullet> or </item-text> ??
-
- my $content = join ' ', splice @$para, 2;
- if($content =~ m/\S/) {
- $self->whine(
- $para->[1]{'start_line'},
- "=back doesn't take any parameters, but you said =back $content"
- );
- }
-
- if(@$curr_open and $curr_open->[-1][0] eq '=over') {
- DEBUG > 1 and print "=back happily closes matching =over\n";
- # Expected case: we're closing the most recently opened thing
- #my $over = pop @$curr_open;
- $self->{'content_seen'} ||= 1;
- $self->_handle_element_end( my $scratch =
- 'over-' . ( (pop @$curr_open)->[1]{'~type'} )
- );
- } else {
- DEBUG > 1 and print "=back found without a matching =over. Stack: (",
- join(', ', map $_->[0], @$curr_open), ").\n";
- $self->whine(
- $para->[1]{'start_line'},
- '=back without =over'
- );
- return 1; # and ignore it
- }
-}
-
-sub _ponder_item {
- my ($self,$para,$curr_open,$paras) = @_;
- my $over;
- unless(@$curr_open and ($over = $curr_open->[-1])->[0] eq '=over') {
- $self->whine(
- $para->[1]{'start_line'},
- "'=item' outside of any '=over'"
- );
- unshift @$paras,
- ['=over', {'start_line' => $para->[1]{'start_line'}}, ''],
- $para
- ;
- return 1;
- }
-
-
- my $over_type = $over->[1]{'~type'};
-
- if(!$over_type) {
- # Shouldn't happen1
- die "Typeless over in stack, starting at line "
- . $over->[1]{'start_line'};
-
- } elsif($over_type eq 'block') {
- unless($curr_open->[-1][1]{'~bitched_about'}) {
- $curr_open->[-1][1]{'~bitched_about'} = 1;
- $self->whine(
- $curr_open->[-1][1]{'start_line'},
- "You can't have =items (as at line "
- . $para->[1]{'start_line'}
- . ") unless the first thing after the =over is an =item"
- );
- }
- # Just turn it into a paragraph and reconsider it
- $para->[0] = '~Para';
- unshift @$paras, $para;
- return 1;
-
- } elsif($over_type eq 'text') {
- my $item_type = $self->_get_item_type($para);
- # That kills the content of the item if it's a number or bullet.
- DEBUG and print " Item is of type ", $para->[0], " under $over_type\n";
-
- if($item_type eq 'text') {
- # Nothing special needs doing for 'text'
- } elsif($item_type eq 'number' or $item_type eq 'bullet') {
- die "Unknown item type $item_type"
- unless $item_type eq 'number' or $item_type eq 'bullet';
- # Undo our clobbering:
- push @$para, $para->[1]{'~orig_content'};
- delete $para->[1]{'number'};
- # Only a PROPER item-number element is allowed
- # to have a number attribute.
- } else {
- die "Unhandled item type $item_type"; # should never happen
- }
-
- # =item-text thingies don't need any assimilation, it seems.
-
- } elsif($over_type eq 'number') {
- my $item_type = $self->_get_item_type($para);
- # That kills the content of the item if it's a number or bullet.
- DEBUG and print " Item is of type ", $para->[0], " under $over_type\n";
-
- my $expected_value = ++ $curr_open->[-1][1]{'~counter'};
-
- if($item_type eq 'bullet') {
- # Hm, it's not numeric. Correct for this.
- $para->[1]{'number'} = $expected_value;
- $self->whine(
- $para->[1]{'start_line'},
- "Expected '=item $expected_value'"
- );
- push @$para, $para->[1]{'~orig_content'};
- # restore the bullet, blocking the assimilation of next para
-
- } elsif($item_type eq 'text') {
- # Hm, it's not numeric. Correct for this.
- $para->[1]{'number'} = $expected_value;
- $self->whine(
- $para->[1]{'start_line'},
- "Expected '=item $expected_value'"
- );
- # Text content will still be there and will block next ~Para
-
- } elsif($item_type ne 'number') {
- die "Unknown item type $item_type"; # should never happen
-
- } elsif($expected_value == $para->[1]{'number'}) {
- DEBUG > 1 and print " Numeric item has the expected value of $expected_value\n";
-
- } else {
- DEBUG > 1 and print " Numeric item has ", $para->[1]{'number'},
- " instead of the expected value of $expected_value\n";
- $self->whine(
- $para->[1]{'start_line'},
- "You have '=item " . $para->[1]{'number'} .
- "' instead of the expected '=item $expected_value'"
- );
- $para->[1]{'number'} = $expected_value; # correcting!!
- }
-
- if(@$para == 2) {
- # For the cases where we /didn't/ push to @$para
- if($paras->[0][0] eq '~Para') {
- DEBUG and print "Assimilating following ~Para content into $over_type item\n";
- push @$para, splice @{shift @$paras},2;
- } else {
- DEBUG and print "Can't assimilate following ", $paras->[0][0], "\n";
- push @$para, ''; # Just so it's not contentless
- }
- }
-
-
- } elsif($over_type eq 'bullet') {
- my $item_type = $self->_get_item_type($para);
- # That kills the content of the item if it's a number or bullet.
- DEBUG and print " Item is of type ", $para->[0], " under $over_type\n";
-
- if($item_type eq 'bullet') {
- # as expected!
-
- if( $para->[1]{'~_freaky_para_hack'} ) {
- DEBUG and print "Accomodating '=item * Foo' tolerance hack.\n";
- push @$para, delete $para->[1]{'~_freaky_para_hack'};
- }
-
- } elsif($item_type eq 'number') {
- $self->whine(
- $para->[1]{'start_line'},
- "Expected '=item *'"
- );
- push @$para, $para->[1]{'~orig_content'};
- # and block assimilation of the next paragraph
- delete $para->[1]{'number'};
- # Only a PROPER item-number element is allowed
- # to have a number attribute.
- } elsif($item_type eq 'text') {
- $self->whine(
- $para->[1]{'start_line'},
- "Expected '=item *'"
- );
- # But doesn't need processing. But it'll block assimilation
- # of the next para.
- } else {
- die "Unhandled item type $item_type"; # should never happen
- }
-
- if(@$para == 2) {
- # For the cases where we /didn't/ push to @$para
- if($paras->[0][0] eq '~Para') {
- DEBUG and print "Assimilating following ~Para content into $over_type item\n";
- push @$para, splice @{shift @$paras},2;
- } else {
- DEBUG and print "Can't assimilate following ", $paras->[0][0], "\n";
- push @$para, ''; # Just so it's not contentless
- }
- }
-
- } else {
- die "Unhandled =over type \"$over_type\"?";
- # Shouldn't happen!
- }
- $para->[0] .= '-' . $over_type;
-
- return;
-}
-
-sub _ponder_Plain {
- my ($self,$para) = @_;
- DEBUG and print " giving plain treatment...\n";
- unless( @$para == 2 or ( @$para == 3 and $para->[2] eq '' )
- or $para->[1]{'~cooked'}
- ) {
- push @$para,
- @{$self->_make_treelet(
- join("\n", splice(@$para, 2)),
- $para->[1]{'start_line'}
- )};
- }
- # Empty paragraphs don't need a treelet for any reason I can see.
- # And precooked paragraphs already have a treelet.
- return;
-}
-
-sub _ponder_Verbatim {
- my ($self,$para) = @_;
- DEBUG and print " giving verbatim treatment...\n";
-
- $para->[1]{'xml:space'} = 'preserve';
- for(my $i = 2; $i < @$para; $i++) {
- foreach my $line ($para->[$i]) { # just for aliasing
- while( $line =~
- # Sort of adapted from Text::Tabs -- yes, it's hardwired in that
- # tabs are at every EIGHTH column. For portability, it has to be
- # one setting everywhere, and 8th wins.
- s/^([^\t]*)(\t+)/$1.(" " x ((length($2)<<3)-(length($1)&7)))/e
- ) {}
-
- # TODO: whinge about (or otherwise treat) unindented or overlong lines
-
- }
- }
-
- # Now the VerbatimFormatted hoodoo...
- if( $self->{'accept_codes'} and
- $self->{'accept_codes'}{'VerbatimFormatted'}
- ) {
- while(@$para > 3 and $para->[-1] !~ m/\S/) { pop @$para }
- # Kill any number of terminal newlines
- $self->_verbatim_format($para);
- } elsif ($self->{'codes_in_verbatim'}) {
- push @$para,
- @{$self->_make_treelet(
- join("\n", splice(@$para, 2)),
- $para->[1]{'start_line'}, $para->[1]{'xml:space'}
- )};
- $para->[-1] =~ s/\n+$//s; # Kill any number of terminal newlines
- } else {
- push @$para, join "\n", splice(@$para, 2) if @$para > 3;
- $para->[-1] =~ s/\n+$//s; # Kill any number of terminal newlines
- }
- return;
-}
-
-sub _ponder_Data {
- my ($self,$para) = @_;
- DEBUG and print " giving data treatment...\n";
- $para->[1]{'xml:space'} = 'preserve';
- push @$para, join "\n", splice(@$para, 2) if @$para > 3;
- return;
-}
-
-
-
-
-###########################################################################
-
-sub _traverse_treelet_bit { # for use only by the routine above
- my($self, $name) = splice @_,0,2;
-
- my $scratch;
- $self->_handle_element_start(($scratch=$name), shift @_);
-
- foreach my $x (@_) {
- if(ref($x)) {
- &_traverse_treelet_bit($self, @$x);
- } else {
- $self->_handle_text($x);
- }
- }
-
- $self->_handle_element_end($scratch=$name);
- return;
-}
-
-#@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
-
-sub _closers_for_all_curr_open {
- my $self = $_[0];
- my @closers;
- foreach my $still_open (@{ $self->{'curr_open'} || return }) {
- my @copy = @$still_open;
- $copy[1] = {%{ $copy[1] }};
- #$copy[1]{'start_line'} = -1;
- if($copy[0] eq '=for') {
- $copy[0] = '=end';
- } elsif($copy[0] eq '=over') {
- $copy[0] = '=back';
- } else {
- die "I don't know how to auto-close an open $copy[0] region";
- }
-
- unless( @copy > 2 ) {
- push @copy, $copy[1]{'target'};
- $copy[-1] = '' unless defined $copy[-1];
- # since =over's don't have targets
- }
-
- DEBUG and print "Queuing up fake-o event: ", pretty(\@copy), "\n";
- unshift @closers, \@copy;
- }
- return @closers;
-}
-
-#--------------------------------------------------------------------------
-
-sub _verbatim_format {
- my($it, $p) = @_;
-
- my $formatting;
-
- for(my $i = 2; $i < @$p; $i++) { # work backwards over the lines
- DEBUG and print "_verbatim_format appends a newline to $i: $p->[$i]\n";
- $p->[$i] .= "\n";
- # Unlike with simple Verbatim blocks, we don't end up just doing
- # a join("\n", ...) on the contents, so we have to append a
- # newline to ever line, and then nix the last one later.
- }
-
- if( DEBUG > 4 ) {
- print "<<\n";
- for(my $i = $#$p; $i >= 2; $i--) { # work backwards over the lines
- print "_verbatim_format $i: $p->[$i]";
- }
- print ">>\n";
- }
-
- for(my $i = $#$p; $i > 2; $i--) {
- # work backwards over the lines, except the first (#2)
-
- #next unless $p->[$i] =~ m{^#:([ \^\/\%]*)\n?$}s
- # and $p->[$i-1] !~ m{^#:[ \^\/\%]*\n?$}s;
- # look at a formatty line preceding a nonformatty one
- DEBUG > 5 and print "Scrutinizing line $i: $$p[$i]\n";
- if($p->[$i] =~ m{^#:([ \^\/\%]*)\n?$}s) {
- DEBUG > 5 and print " It's a formatty line. ",
- "Peeking at previous line ", $i-1, ": $$p[$i-1]: \n";
-
- if( $p->[$i-1] =~ m{^#:[ \^\/\%]*\n?$}s ) {
- DEBUG > 5 and print " Previous line is formatty! Skipping this one.\n";
- next;
- } else {
- DEBUG > 5 and print " Previous line is non-formatty! Yay!\n";
- }
- } else {
- DEBUG > 5 and print " It's not a formatty line. Ignoring\n";
- next;
- }
-
- # A formatty line has to have #: in the first two columns, and uses
- # "^" to mean bold, "/" to mean underline, and "%" to mean bold italic.
- # Example:
- # What do you want? i like pie. [or whatever]
- # #:^^^^^^^^^^^^^^^^^ /////////////
-
-
- DEBUG > 4 and print "_verbatim_format considers:\n<$p->[$i-1]>\n<$p->[$i]>\n";
-
- $formatting = ' ' . $1;
- $formatting =~ s/\s+$//s; # nix trailing whitespace
- unless(length $formatting and $p->[$i-1] =~ m/\S/) { # no-op
- splice @$p,$i,1; # remove this line
- $i--; # don't consider next line
- next;
- }
-
- if( length($formatting) >= length($p->[$i-1]) ) {
- $formatting = substr($formatting, 0, length($p->[$i-1]) - 1) . ' ';
- } else {
- $formatting .= ' ' x (length($p->[$i-1]) - length($formatting));
- }
- # Make $formatting and the previous line be exactly the same length,
- # with $formatting having a " " as the last character.
-
- DEBUG > 4 and print "Formatting <$formatting> on <", $p->[$i-1], ">\n";
-
-
- my @new_line;
- while( $formatting =~ m{\G(( +)|(\^+)|(\/+)|(\%+))}g ) {
- #print "Format matches $1\n";
-
- if($2) {
- #print "SKIPPING <$2>\n";
- push @new_line,
- substr($p->[$i-1], pos($formatting)-length($1), length($1));
- } else {
- #print "SNARING $+\n";
- push @new_line, [
- (
- $3 ? 'VerbatimB' :
- $4 ? 'VerbatimI' :
- $5 ? 'VerbatimBI' : die("Should never get called")
- ), {},
- substr($p->[$i-1], pos($formatting)-length($1), length($1))
- ];
- #print "Formatting <$new_line[-1][-1]> as $new_line[-1][0]\n";
- }
- }
- my @nixed =
- splice @$p, $i-1, 2, @new_line; # replace myself and the next line
- DEBUG > 10 and print "Nixed count: ", scalar(@nixed), "\n";
-
- DEBUG > 6 and print "New version of the above line is these tokens (",
- scalar(@new_line), "):",
- map( ref($_)?"<@$_> ":"<$_>", @new_line ), "\n";
- $i--; # So the next line we scrutinize is the line before the one
- # that we just went and formatted
- }
-
- $p->[0] = 'VerbatimFormatted';
-
- # Collapse adjacent text nodes, just for kicks.
- for( my $i = 2; $i > $#$p; $i++ ) { # work forwards over the tokens except for the last
- if( !ref($p->[$i]) and !ref($p->[$i + 1]) ) {
- DEBUG > 5 and print "_verbatim_format merges {$p->[$i]} and {$p->[$i+1]}\n";
- $p->[$i] .= splice @$p, $i+1, 1; # merge
- --$i; # and back up
- }
- }
-
- # Now look for the last text token, and remove the terminal newline
- for( my $i = $#$p; $i >= 2; $i-- ) {
- # work backwards over the tokens, even the first
- if( !ref($p->[$i]) ) {
- if($p->[$i] =~ s/\n$//s) {
- DEBUG > 5 and print "_verbatim_format killed the terminal newline on #$i: {$p->[$i]}, after {$p->[$i-1]}\n";
- } else {
- DEBUG > 5 and print
- "No terminal newline on #$i: {$p->[$i]}, after {$p->[$i-1]} !?\n";
- }
- last; # we only want the next one
- }
- }
-
- return;
-}
-
-
-#@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
-
-
-sub _treelet_from_formatting_codes {
- # Given a paragraph, returns a treelet. Full of scary tokenizing code.
- # Like [ '~Top', {'start_line' => $start_line},
- # "I like ",
- # [ 'B', {}, "pie" ],
- # "!"
- # ]
-
- my($self, $para, $start_line, $preserve_space) = @_;
-
- my $treelet = ['~Top', {'start_line' => $start_line},];
-
- unless ($preserve_space || $self->{'preserve_whitespace'}) {
- $para =~ s/\. /\.\xA0 /g if $self->{'fullstop_space_harden'};
-
- $para =~ s/\s+/ /g; # collapse and trim all whitespace first.
- $para =~ s/ $//;
- $para =~ s/^ //;
- }
-
- # Only apparent problem the above code is that N<< >> turns into
- # N<< >>. But then, word wrapping does that too! So don't do that!
-
- my @stack;
- my @lineage = ($treelet);
-
- DEBUG > 4 and print "Paragraph:\n$para\n\n";
-
- # Here begins our frightening tokenizer RE. The following regex matches
- # text in four main parts:
- #
- # * Start-codes. The first alternative matches C< or C<<, the latter
- # followed by some whitespace. $1 will hold the entire start code
- # (including any space following a multiple-angle-bracket delimiter),
- # and $2 will hold only the additional brackets past the first in a
- # multiple-bracket delimiter. length($2) + 1 will be the number of
- # closing brackets we have to find.
- #
- # * Closing brackets. Match some amount of whitespace followed by
- # multiple close brackets. The logic to see if this closes anything
- # is down below. Note that in order to parse C<< >> correctly, we
- # have to use look-behind (?<=\s\s), since the match of the starting
- # code will have consumed the whitespace.
- #
- # * A single closing bracket, to close a simple code like C<>.
- #
- # * Something that isn't a start or end code. We have to be careful
- # about accepting whitespace, since perlpodspec says that any whitespace
- # before a multiple-bracket closing delimiter should be ignored.
- #
- while($para =~
- m/\G
- (?:
- # Match starting codes, including the whitespace following a
- # multiple-delimiter start code. $1 gets the whole start code and
- # $2 gets all but one of the <s in the multiple-bracket case.
- ([A-Z]<(?:(<+)\s+)?)
- |
- # Match multiple-bracket end codes. $3 gets the whitespace that
- # should be discarded before an end bracket but kept in other cases
- # and $4 gets the end brackets themselves.
- (\s+|(?<=\s\s))(>{2,})
- |
- (\s?>) # $5: simple end-codes
- |
- ( # $6: stuff containing no start-codes or end-codes
- (?:
- [^A-Z\s>]
- |
- (?:
- [A-Z](?!<)
- )
- |
- (?:
- \s(?!\s*>)
- )
- )+
- )
- )
- /xgo
- ) {
- DEBUG > 4 and print "\nParagraphic tokenstack = (@stack)\n";
- if(defined $1) {
- if(defined $2) {
- DEBUG > 3 and print "Found complex start-text code \"$1\"\n";
- push @stack, length($2) + 1;
- # length of the necessary complex end-code string
- } else {
- DEBUG > 3 and print "Found simple start-text code \"$1\"\n";
- push @stack, 0; # signal that we're looking for simple
- }
- push @lineage, [ substr($1,0,1), {}, ]; # new node object
- push @{ $lineage[-2] }, $lineage[-1];
-
- } elsif(defined $4) {
- DEBUG > 3 and print "Found apparent complex end-text code \"$3$4\"\n";
- # This is where it gets messy...
- if(! @stack) {
- # We saw " >>>>" but needed nothing. This is ALL just stuff then.
- DEBUG > 4 and print " But it's really just stuff.\n";
- push @{ $lineage[-1] }, $3, $4;
- next;
- } elsif(!$stack[-1]) {
- # We saw " >>>>" but needed only ">". Back pos up.
- DEBUG > 4 and print " And that's more than we needed to close simple.\n";
- push @{ $lineage[-1] }, $3; # That was a for-real space, too.
- pos($para) = pos($para) - length($4) + 1;
- } elsif($stack[-1] == length($4)) {
- # We found " >>>>", and it was exactly what we needed. Commonest case.
- DEBUG > 4 and print " And that's exactly what we needed to close complex.\n";
- } elsif($stack[-1] < length($4)) {
- # We saw " >>>>" but needed only " >>". Back pos up.
- DEBUG > 4 and print " And that's more than we needed to close complex.\n";
- pos($para) = pos($para) - length($4) + $stack[-1];
- } else {
- # We saw " >>>>" but needed " >>>>>>". So this is all just stuff!
- DEBUG > 4 and print " But it's really just stuff, because we needed more.\n";
- push @{ $lineage[-1] }, $3, $4;
- next;
- }
- #print "\nHOOBOY ", scalar(@{$lineage[-1]}), "!!!\n";
-
- push @{ $lineage[-1] }, '' if 2 == @{ $lineage[-1] };
- # Keep the element from being childless
-
- pop @stack;
- pop @lineage;
-
- } elsif(defined $5) {
- DEBUG > 3 and print "Found apparent simple end-text code \"$4\"\n";
-
- if(@stack and ! $stack[-1]) {
- # We're indeed expecting a simple end-code
- DEBUG > 4 and print " It's indeed an end-code.\n";
-
- if(length($5) == 2) { # There was a space there: " >"
- push @{ $lineage[-1] }, ' ';
- } elsif( 2 == @{ $lineage[-1] } ) { # Closing a childless element
- push @{ $lineage[-1] }, ''; # keep it from being really childless
- }
-
- pop @stack;
- pop @lineage;
- } else {
- DEBUG > 4 and print " It's just stuff.\n";
- push @{ $lineage[-1] }, $5;
- }
-
- } elsif(defined $6) {
- DEBUG > 3 and print "Found stuff \"$6\"\n";
- push @{ $lineage[-1] }, $6;
-
- } else {
- # should never ever ever ever happen
- DEBUG and print "AYYAYAAAAA at line ", __LINE__, "\n";
- die "SPORK 512512!";
- }
- }
-
- if(@stack) { # Uhoh, some sequences weren't closed.
- my $x= "...";
- while(@stack) {
- push @{ $lineage[-1] }, '' if 2 == @{ $lineage[-1] };
- # Hmmmmm!
-
- my $code = (pop @lineage)->[0];
- my $ender_length = pop @stack;
- if($ender_length) {
- --$ender_length;
- $x = $code . ("<" x $ender_length) . " $x " . (">" x $ender_length);
- } else {
- $x = $code . "<$x>";
- }
- }
- DEBUG > 1 and print "Unterminated $x sequence\n";
- $self->whine($start_line,
- "Unterminated $x sequence",
- );
- }
-
- return $treelet;
-}
-
-#@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
-
-sub text_content_of_treelet { # method: $parser->text_content_of_treelet($lol)
- return stringify_lol($_[1]);
-}
-
-sub stringify_lol { # function: stringify_lol($lol)
- my $string_form = '';
- _stringify_lol( $_[0] => \$string_form );
- return $string_form;
-}
-
-sub _stringify_lol { # the real recursor
- my($lol, $to) = @_;
- use UNIVERSAL ();
- for(my $i = 2; $i < @$lol; ++$i) {
- if( ref($lol->[$i] || '') and UNIVERSAL::isa($lol->[$i], 'ARRAY') ) {
- _stringify_lol( $lol->[$i], $to); # recurse!
- } else {
- $$to .= $lol->[$i];
- }
- }
- return;
-}
-
-#@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
-
-sub _dump_curr_open { # return a string representation of the stack
- my $curr_open = $_[0]{'curr_open'};
-
- return '[empty]' unless @$curr_open;
- return join '; ',
- map {;
- ($_->[0] eq '=for')
- ? ( ($_->[1]{'~really'} || '=over')
- . ' ' . $_->[1]{'target'})
- : $_->[0]
- }
- @$curr_open
- ;
-}
-
-###########################################################################
-my %pretty_form = (
- "\a" => '\a', # ding!
- "\b" => '\b', # BS
- "\e" => '\e', # ESC
- "\f" => '\f', # FF
- "\t" => '\t', # tab
- "\cm" => '\cm',
- "\cj" => '\cj',
- "\n" => '\n', # probably overrides one of either \cm or \cj
- '"' => '\"',
- '\\' => '\\\\',
- '$' => '\\$',
- '@' => '\\@',
- '%' => '\\%',
- '#' => '\\#',
-);
-
-sub pretty { # adopted from Class::Classless
- # Not the most brilliant routine, but passable.
- # Don't give it a cyclic data structure!
- my @stuff = @_; # copy
- my $x;
- my $out =
- # join ",\n" .
- join ", ",
- map {;
- if(!defined($_)) {
- "undef";
- } elsif(ref($_) eq 'ARRAY' or ref($_) eq 'Pod::Simple::LinkSection') {
- $x = "[ " . pretty(@$_) . " ]" ;
- $x;
- } elsif(ref($_) eq 'SCALAR') {
- $x = "\\" . pretty($$_) ;
- $x;
- } elsif(ref($_) eq 'HASH') {
- my $hr = $_;
- $x = "{" . join(", ",
- map(pretty($_) . '=>' . pretty($hr->{$_}),
- sort keys %$hr ) ) . "}" ;
- $x;
- } elsif(!length($_)) { q{''} # empty string
- } elsif(
- $_ eq '0' # very common case
- or(
- m/^-?(?:[123456789]\d*|0)(?:\.\d+)?$/s
- and $_ ne '-0' # the strange case that that RE lets thru
- )
- ) { $_;
- } else {
- if( chr(65) eq 'A' ) {
- s<([^\x20\x21\x23\x27-\x3F\x41-\x5B\x5D-\x7E])>
- #<$pretty_form{$1} || '\\x'.(unpack("H2",$1))>eg;
- <$pretty_form{$1} || '\\x{'.sprintf("%x", ord($1)).'}'>eg;
- } else {
- # We're in some crazy non-ASCII world!
- s<([^abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789])>
- #<$pretty_form{$1} || '\\x'.(unpack("H2",$1))>eg;
- <$pretty_form{$1} || '\\x{'.sprintf("%x", ord($1)).'}'>eg;
- }
- qq{"$_"};
- }
- } @stuff;
- # $out =~ s/\n */ /g if length($out) < 75;
- return $out;
-}
-
-#@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
-
-# A rather unsubtle method of blowing away all the state information
-# from a parser object so it can be reused. Provided as a utility for
-# backward compatibilty in Pod::Man, etc. but not recommended for
-# general use.
-
-sub reinit {
- my $self = shift;
- foreach (qw(source_dead source_filename doc_has_started
-start_of_pod_block content_seen last_was_blank paras curr_open
-line_count pod_para_count in_pod ~tried_gen_errata errata errors_seen
-Title)) {
-
- delete $self->{$_};
- }
-}
-
-#@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
-1;
-
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Pod/Simple/Checker.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Pod/Simple/Checker.pm
deleted file mode 100644
index 0d01f50ec2f..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Pod/Simple/Checker.pm
+++ /dev/null
@@ -1,171 +0,0 @@
-
-# A quite dimwitted pod2plaintext that need only know how to format whatever
-# text comes out of Pod::BlackBox's _gen_errata
-
-require 5;
-package Pod::Simple::Checker;
-use strict;
-use Carp ();
-use Pod::Simple::Methody ();
-use Pod::Simple ();
-use vars qw( @ISA $VERSION );
-$VERSION = '2.02';
-@ISA = ('Pod::Simple::Methody');
-BEGIN { *DEBUG = defined(&Pod::Simple::DEBUG)
- ? \&Pod::Simple::DEBUG
- : sub() {0}
- }
-
-use Text::Wrap 98.112902 (); # was 2001.0131, but I don't think we need that
-$Text::Wrap::wrap = 'overflow';
-#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-sub any_errata_seen { # read-only accessor
- return $_[1]->{'Errata_seen'};
-}
-
-sub new {
- my $self = shift;
- my $new = $self->SUPER::new(@_);
- $new->{'output_fh'} ||= *STDOUT{IO};
- $new->nix_X_codes(1);
- $new->nbsp_for_S(1);
- $new->{'Thispara'} = '';
- $new->{'Indent'} = 0;
- $new->{'Indentstring'} = ' ';
- $new->{'Errata_seen'} = 0;
- return $new;
-}
-
-#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-sub handle_text { $_[0]{'Errata_seen'} and $_[0]{'Thispara'} .= $_[1] }
-
-sub start_Para { $_[0]{'Thispara'} = '' }
-
-sub start_head1 {
- if($_[0]{'Errata_seen'}) {
- $_[0]{'Thispara'} = '';
- } else {
- if($_[1]{'errata'}) { # start of errata!
- $_[0]{'Errata_seen'} = 1;
- $_[0]{'Thispara'} = $_[0]{'source_filename'} ?
- "$_[0]{'source_filename'} -- " : ''
- }
- }
-}
-sub start_head2 { $_[0]{'Thispara'} = '' }
-sub start_head3 { $_[0]{'Thispara'} = '' }
-sub start_head4 { $_[0]{'Thispara'} = '' }
-
-sub start_Verbatim { $_[0]{'Thispara'} = '' }
-sub start_item_bullet { $_[0]{'Thispara'} = '* ' }
-sub start_item_number { $_[0]{'Thispara'} = "$_[1]{'number'}. " }
-sub start_item_text { $_[0]{'Thispara'} = '' }
-
-sub start_over_bullet { ++$_[0]{'Indent'} }
-sub start_over_number { ++$_[0]{'Indent'} }
-sub start_over_text { ++$_[0]{'Indent'} }
-sub start_over_block { ++$_[0]{'Indent'} }
-
-sub end_over_bullet { --$_[0]{'Indent'} }
-sub end_over_number { --$_[0]{'Indent'} }
-sub end_over_text { --$_[0]{'Indent'} }
-sub end_over_block { --$_[0]{'Indent'} }
-
-
-# . . . . . Now the actual formatters:
-
-sub end_head1 { $_[0]->emit_par(-4) }
-sub end_head2 { $_[0]->emit_par(-3) }
-sub end_head3 { $_[0]->emit_par(-2) }
-sub end_head4 { $_[0]->emit_par(-1) }
-sub end_Para { $_[0]->emit_par( 0) }
-sub end_item_bullet { $_[0]->emit_par( 0) }
-sub end_item_number { $_[0]->emit_par( 0) }
-sub end_item_text { $_[0]->emit_par(-2) }
-
-sub emit_par {
- return unless $_[0]{'Errata_seen'};
- my($self, $tweak_indent) = splice(@_,0,2);
- my $indent = ' ' x ( 2 * $self->{'Indent'} + ($tweak_indent||0) );
- # Yes, 'STRING' x NEGATIVE gives '', same as 'STRING' x 0
-
- $self->{'Thispara'} =~ tr{\xAD}{}d if Pod::Simple::ASCII;
- my $out = Text::Wrap::wrap($indent, $indent, $self->{'Thispara'} .= "\n");
- $out =~ tr{\xA0}{ } if Pod::Simple::ASCII;
- print {$self->{'output_fh'}} $out,
- #"\n"
- ;
- $self->{'Thispara'} = '';
-
- return;
-}
-
-# . . . . . . . . . . And then off by its lonesome:
-
-sub end_Verbatim {
- return unless $_[0]{'Errata_seen'};
- my $self = shift;
- if(Pod::Simple::ASCII) {
- $self->{'Thispara'} =~ tr{\xA0}{ };
- $self->{'Thispara'} =~ tr{\xAD}{}d;
- }
-
- my $i = ' ' x ( 2 * $self->{'Indent'} + 4);
-
- $self->{'Thispara'} =~ s/^/$i/mg;
-
- print { $self->{'output_fh'} } '',
- $self->{'Thispara'},
- "\n\n"
- ;
- $self->{'Thispara'} = '';
- return;
-}
-
-#@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
-1;
-
-__END__
-
-=head1 NAME
-
-Pod::Simple::Checker -- check the Pod syntax of a document
-
-=head1 SYNOPSIS
-
- perl -MPod::Simple::Checker -e \
- "exit Pod::Simple::Checker->filter(shift)->any_errata_seen" \
- thingy.pod
-
-=head1 DESCRIPTION
-
-This class is for checking the syntactic validity of Pod.
-It works by basically acting like a simple-minded version of
-L<Pod::Simple::Text> that formats only the "Pod Errors" section
-(if Pod::Simple even generates one for the given document).
-
-This is a subclass of L<Pod::Simple> and inherits all its methods.
-
-=head1 SEE ALSO
-
-L<Pod::Simple>, L<Pod::Simple::Text>, L<Pod::Checker>
-
-=head1 COPYRIGHT AND DISCLAIMERS
-
-Copyright (c) 2002 Sean M. Burke. All rights reserved.
-
-This library 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.
-
-=head1 AUTHOR
-
-Sean M. Burke C<sburke@cpan.org>
-
-=cut
-
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Pod/Simple/Debug.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Pod/Simple/Debug.pm
deleted file mode 100644
index b00e58daba8..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Pod/Simple/Debug.pm
+++ /dev/null
@@ -1,151 +0,0 @@
-
-require 5;
-package Pod::Simple::Debug;
-use strict;
-
-sub import {
- my($value,$variable);
-
- if(@_ == 2) {
- $value = $_[1];
- } elsif(@_ == 3) {
- ($variable, $value) = @_[1,2];
-
- ($variable, $value) = ($value, $variable)
- if defined $value and ref($value) eq 'SCALAR'
- and not(defined $variable and ref($variable) eq 'SCALAR')
- ; # tolerate getting it backwards
-
- unless( defined $variable and ref($variable) eq 'SCALAR') {
- require Carp;
- Carp::croak("Usage:\n use Pod::Simple::Debug (NUMVAL)\nor"
- . "\n use Pod::Simple::Debug (\\\$var, STARTNUMVAL)\nAborting");
- }
- } else {
- require Carp;
- Carp::croak("Usage:\n use Pod::Simple::Debug (NUMVAL)\nor"
- . "\n use Pod::Simple::Debug (\\\$var, STARTNUMVAL)\nAborting");
- }
-
- if( defined &Pod::Simple::DEBUG ) {
- require Carp;
- Carp::croak("It's too late to call Pod::Simple::Debug -- "
- . "Pod::Simple has already loaded\nAborting");
- }
-
- $value = 0 unless defined $value;
-
- unless($value =~ m/^-?\d+$/) {
- require Carp;
- Carp::croak( "$value isn't a numeric value."
- . "\nUsage:\n use Pod::Simple::Debug (NUMVAL)\nor"
- . "\n use Pod::Simple::Debug (\\\$var, STARTNUMVAL)\nAborting");
- }
-
- if( defined $variable ) {
- # make a not-really-constant
- *Pod::Simple::DEBUG = sub () { $$variable } ;
- $$variable = $value;
- print "# Starting Pod::Simple::DEBUG = non-constant $variable with val $value\n";
- } else {
- *Pod::Simple::DEBUG = eval " sub () { $value } ";
- print "# Starting Pod::Simple::DEBUG = $value\n";
- }
-
- require Pod::Simple;
- return;
-}
-
-1;
-
-
-__END__
-
-=head1 NAME
-
-Pod::Simple::Debug -- put Pod::Simple into trace/debug mode
-
-=head1 SYNOPSIS
-
- use Pod::Simple::Debug (5); # or some integer
-
-Or:
-
- my $debuglevel;
- use Pod::Simple::Debug (\$debuglevel, 0);
- ...some stuff that uses Pod::Simple to do stuff, but which
- you don't want debug output from...
-
- $debug_level = 4;
- ...some stuff that uses Pod::Simple to do stuff, but which
- you DO want debug output from...
-
- $debug_level = 0;
-
-=head1 DESCRIPTION
-
-This is an internal module for controlling the debug level (a.k.a. trace
-level) of Pod::Simple. This is of interest only to Pod::Simple
-developers.
-
-
-=head1 CAVEATS
-
-Note that you should load this module I<before> loading Pod::Simple (or
-any Pod::Simple-based class). If you try loading Pod::Simple::Debug
-after &Pod::Simple::DEBUG is already defined, Pod::Simple::Debug will
-throw a fatal error to the effect that
-"it's s too late to call Pod::Simple::Debug".
-
-Note that the C<use Pod::Simple::Debug (\$x, I<somenum>)> mode will make
-Pod::Simple (et al) run rather slower, since &Pod::Simple::DEBUG won't
-be a constant sub anymore, and so Pod::Simple (et al) won't compile with
-constant-folding.
-
-
-=head1 GUTS
-
-Doing this:
-
- use Pod::Simple::Debug (5); # or some integer
-
-is basically equivalent to:
-
- BEGIN { sub Pod::Simple::DEBUG () {5} } # or some integer
- use Pod::Simple ();
-
-And this:
-
- use Pod::Simple::Debug (\$debug_level,0); # or some integer
-
-is basically equivalent to this:
-
- my $debug_level;
- BEGIN { $debug_level = 0 }
- BEGIN { sub Pod::Simple::DEBUG () { $debug_level }
- use Pod::Simple ();
-
-=head1 SEE ALSO
-
-L<Pod::Simple>
-
-The article "Constants in Perl", in I<The Perl Journal> issue
-21. See L<http://www.sysadminmag.com/tpj/issues/vol5_5/>
-
-=head1 COPYRIGHT AND DISCLAIMERS
-
-Copyright (c) 2002 Sean M. Burke. All rights reserved.
-
-This library 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.
-
-=head1 AUTHOR
-
-Sean M. Burke C<sburke@cpan.org>
-
-=cut
-
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Pod/Simple/DumpAsText.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Pod/Simple/DumpAsText.pm
deleted file mode 100644
index e678e42fa18..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Pod/Simple/DumpAsText.pm
+++ /dev/null
@@ -1,130 +0,0 @@
-
-require 5;
-package Pod::Simple::DumpAsText;
-$VERSION = '2.02';
-use Pod::Simple ();
-BEGIN {@ISA = ('Pod::Simple')}
-
-use strict;
-
-use Carp ();
-
-BEGIN { *DEBUG = \&Pod::Simple::DEBUG unless defined &DEBUG }
-
-sub new {
- my $self = shift;
- my $new = $self->SUPER::new(@_);
- $new->{'output_fh'} ||= *STDOUT{IO};
- $new->accept_codes('VerbatimFormatted');
- return $new;
-}
-
-#@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
-
-sub _handle_element_start {
- # ($self, $element_name, $attr_hash_r)
- my $fh = $_[0]{'output_fh'};
- my($key, $value);
- DEBUG and print "++ $_[1]\n";
-
- print $fh ' ' x ($_[0]{'indent'} || 0), "++", $_[1], "\n";
- $_[0]{'indent'}++;
- while(($key,$value) = each %{$_[2]}) {
- unless($key =~ m/^~/s) {
- next if $key eq 'start_line' and $_[0]{'hide_line_numbers'};
- _perly_escape($key);
- _perly_escape($value);
- printf $fh qq{%s \\ "%s" => "%s"\n},
- ' ' x ($_[0]{'indent'} || 0), $key, $value;
- }
- }
- return;
-}
-
-sub _handle_text {
- DEBUG and print "== \"$_[1]\"\n";
-
- if(length $_[1]) {
- my $indent = ' ' x $_[0]{'indent'};
- my $text = $_[1];
- _perly_escape($text);
- $text =~ # A not-totally-brilliant wrapping algorithm:
- s/(
- [^\n]{55} # Snare some characters from a line
- [^\n\ ]{0,50} # and finish any current word
- )
- \x20{1,10}(?!\n) # capture some spaces not at line-end
- /$1"\n$indent . "/gx # => line-break here
- ;
-
- print {$_[0]{'output_fh'}} $indent, '* "', $text, "\"\n";
- }
- return;
-}
-
-sub _handle_element_end {
- DEBUG and print "-- $_[1]\n";
- print {$_[0]{'output_fh'}}
- ' ' x --$_[0]{'indent'}, "--", $_[1], "\n";
- return;
-}
-
-# . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
-
-sub _perly_escape {
- foreach my $x (@_) {
- $x =~ s/([^\x00-\xFF])/sprintf'\x{%X}',ord($1)/eg;
- # Escape things very cautiously:
- $x =~ s/([^-\n\t \&\<\>\'!\#\%\(\)\*\+,\.\/\:\;=\?\~\[\]\^_\`\{\|\}abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789])/sprintf'\x%02X',ord($1)/eg;
- }
- return;
-}
-
-#@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
-1;
-
-
-__END__
-
-=head1 NAME
-
-Pod::Simple::DumpAsText -- dump Pod-parsing events as text
-
-=head1 SYNOPSIS
-
- perl -MPod::Simple::DumpAsText -e \
- "exit Pod::Simple::DumpAsText->filter(shift)->any_errata_seen" \
- thingy.pod
-
-=head1 DESCRIPTION
-
-This class is for dumping, as text, the events gotten from parsing a Pod
-document. This class is of interest to people writing Pod formatters
-based on Pod::Simple. It is useful for seeing exactly what events you
-get out of some Pod that you feed in.
-
-This is a subclass of L<Pod::Simple> and inherits all its methods.
-
-=head1 SEE ALSO
-
-L<Pod::Simple::DumpAsXML>
-
-L<Pod::Simple>
-
-=head1 COPYRIGHT AND DISCLAIMERS
-
-Copyright (c) 2002 Sean M. Burke. All rights reserved.
-
-This library 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.
-
-=head1 AUTHOR
-
-Sean M. Burke C<sburke@cpan.org>
-
-=cut
-
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Pod/Simple/DumpAsXML.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Pod/Simple/DumpAsXML.pm
deleted file mode 100644
index fe0c1662e5d..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Pod/Simple/DumpAsXML.pm
+++ /dev/null
@@ -1,146 +0,0 @@
-
-require 5;
-package Pod::Simple::DumpAsXML;
-$VERSION = '2.02';
-use Pod::Simple ();
-BEGIN {@ISA = ('Pod::Simple')}
-
-use strict;
-
-use Carp ();
-
-BEGIN { *DEBUG = \&Pod::Simple::DEBUG unless defined &DEBUG }
-
-sub new {
- my $self = shift;
- my $new = $self->SUPER::new(@_);
- $new->{'output_fh'} ||= *STDOUT{IO};
- $new->accept_codes('VerbatimFormatted');
- return $new;
-}
-
-#@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
-
-sub _handle_element_start {
- # ($self, $element_name, $attr_hash_r)
- my $fh = $_[0]{'output_fh'};
- my($key, $value);
- DEBUG and print "++ $_[1]\n";
-
- print $fh ' ' x ($_[0]{'indent'} || 0), "<", $_[1];
-
- foreach my $key (sort keys %{$_[2]}) {
- unless($key =~ m/^~/s) {
- next if $key eq 'start_line' and $_[0]{'hide_line_numbers'};
- _xml_escape($value = $_[2]{$key});
- print $fh ' ', $key, '="', $value, '"';
- }
- }
-
-
- print $fh ">\n";
- $_[0]{'indent'}++;
- return;
-}
-
-sub _handle_text {
- DEBUG and print "== \"$_[1]\"\n";
- if(length $_[1]) {
- my $indent = ' ' x $_[0]{'indent'};
- my $text = $_[1];
- _xml_escape($text);
- $text =~ # A not-totally-brilliant wrapping algorithm:
- s/(
- [^\n]{55} # Snare some characters from a line
- [^\n\ ]{0,50} # and finish any current word
- )
- \x20{1,10}(?!\n) # capture some spaces not at line-end
- /$1\n$indent/gx # => line-break here
- ;
-
- print {$_[0]{'output_fh'}} $indent, $text, "\n";
- }
- return;
-}
-
-sub _handle_element_end {
- DEBUG and print "-- $_[1]\n";
- print {$_[0]{'output_fh'}}
- ' ' x --$_[0]{'indent'}, "</", $_[1], ">\n";
- return;
-}
-
-# . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
-
-sub _xml_escape {
- foreach my $x (@_) {
- # Escape things very cautiously:
- $x =~ s/([^-\n\t !\#\$\%\(\)\*\+,\.\~\/\:\;=\?\@\[\\\]\^_\`\{\|\}abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789])/'&#'.(ord($1)).';'/eg;
- # Yes, stipulate the list without a range, so that this can work right on
- # all charsets that this module happens to run under.
- # Altho, hmm, what about that ord? Presumably that won't work right
- # under non-ASCII charsets. Something should be done about that.
- }
- return;
-}
-
-#@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
-1;
-
-__END__
-
-=head1 NAME
-
-Pod::Simple::DumpAsXML -- turn Pod into XML
-
-=head1 SYNOPSIS
-
- perl -MPod::Simple::DumpAsXML -e \
- "exit Pod::Simple::DumpAsXML->filter(shift)->any_errata_seen" \
- thingy.pod
-
-=head1 DESCRIPTION
-
-Pod::Simple::DumpAsXML is a subclass of L<Pod::Simple> that parses Pod
-and turns it into indented and wrapped XML. This class is of
-interest to people writing Pod formatters based on Pod::Simple.
-
-Pod::Simple::DumpAsXML inherits methods from
-L<Pod::Simple>.
-
-
-=head1 SEE ALSO
-
-L<Pod::Simple::XMLOutStream> is rather like this class.
-Pod::Simple::XMLOutStream's output is space-padded in a way
-that's better for sending to an XML processor (that is, it has
-no ignoreable whitespace). But
-Pod::Simple::DumpAsXML's output is much more human-readable, being
-(more-or-less) one token per line, with line-wrapping.
-
-L<Pod::Simple::DumpAsText> is rather like this class,
-except that it doesn't dump with XML syntax. Try them and see
-which one you like best!
-
-L<Pod::Simple>, L<Pod::Simple::DumpAsXML>
-
-The older libraries L<Pod::PXML>, L<Pod::XML>, L<Pod::SAX>
-
-
-=head1 COPYRIGHT AND DISCLAIMERS
-
-Copyright (c) 2002 Sean M. Burke. All rights reserved.
-
-This library 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.
-
-=head1 AUTHOR
-
-Sean M. Burke C<sburke@cpan.org>
-
-=cut
-
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Pod/Simple/HTML.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Pod/Simple/HTML.pm
deleted file mode 100644
index c0a505d533e..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Pod/Simple/HTML.pm
+++ /dev/null
@@ -1,889 +0,0 @@
-
-require 5;
-package Pod::Simple::HTML;
-use strict;
-use Pod::Simple::PullParser ();
-use vars qw(
- @ISA %Tagmap $Computerese $LamePad $Linearization_Limit $VERSION
- $Perldoc_URL_Prefix $Perldoc_URL_Postfix
- $Title_Prefix $Title_Postfix $HTML_EXTENSION %ToIndex
- $Doctype_decl $Content_decl
-);
-@ISA = ('Pod::Simple::PullParser');
-$VERSION = '3.03';
-
-use UNIVERSAL ();
-BEGIN {
- if(defined &DEBUG) { } # no-op
- elsif( defined &Pod::Simple::DEBUG ) { *DEBUG = \&Pod::Simple::DEBUG }
- else { *DEBUG = sub () {0}; }
-}
-
-$Doctype_decl ||= ''; # No. Just No. Don't even ask me for it.
- # qq{<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN"
- # "http://www.w3.org/TR/html4/loose.dtd">\n};
-
-$Content_decl ||=
- q{<meta http-equiv="Content-Type" content="text/html; charset=ISO-8859-1" >};
-
-$HTML_EXTENSION = '.html' unless defined $HTML_EXTENSION;
-$Computerese = "" unless defined $Computerese;
-$LamePad = '' unless defined $LamePad;
-
-$Linearization_Limit = 120 unless defined $Linearization_Limit;
- # headings/items longer than that won't get an <a name="...">
-$Perldoc_URL_Prefix = 'http://search.cpan.org/perldoc?'
- unless defined $Perldoc_URL_Prefix;
-$Perldoc_URL_Postfix = ''
- unless defined $Perldoc_URL_Postfix;
-
-$Title_Prefix = '' unless defined $Title_Prefix;
-$Title_Postfix = '' unless defined $Title_Postfix;
-%ToIndex = map {; $_ => 1 } qw(head1 head2 head3 head4 ); # item-text
- # 'item-text' stuff in the index doesn't quite work, and may
- # not be a good idea anyhow.
-
-
-__PACKAGE__->_accessorize(
- 'perldoc_url_prefix',
- # In turning L<Foo::Bar> into http://whatever/Foo%3a%3aBar, what
- # to put before the "Foo%3a%3aBar".
- # (for singleton mode only?)
- 'perldoc_url_postfix',
- # what to put after "Foo%3a%3aBar" in the URL. Normally "".
-
- 'batch_mode', # whether we're in batch mode
- 'batch_mode_current_level',
- # When in batch mode, how deep the current module is: 1 for "LWP",
- # 2 for "LWP::Procotol", 3 for "LWP::Protocol::GHTTP", etc
-
- 'title_prefix', 'title_postfix',
- # What to put before and after the title in the head.
- # Should already be &-escaped
-
- 'html_header_before_title',
- 'html_header_after_title',
- 'html_footer',
-
- 'index', # whether to add an index at the top of each page
- # (actually it's a table-of-contents, but we'll call it an index,
- # out of apparently longstanding habit)
-
- 'html_css', # URL of CSS file to point to
- 'html_javascript', # URL of CSS file to point to
-
- 'force_title', # should already be &-escaped
- 'default_title', # should already be &-escaped
-);
-
-#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-my @_to_accept;
-
-%Tagmap = (
- 'Verbatim' => "\n<pre$Computerese>",
- '/Verbatim' => "</pre>\n",
- 'VerbatimFormatted' => "\n<pre$Computerese>",
- '/VerbatimFormatted' => "</pre>\n",
- 'VerbatimB' => "<b>",
- '/VerbatimB' => "</b>",
- 'VerbatimI' => "<i>",
- '/VerbatimI' => "</i>",
- 'VerbatimBI' => "<b><i>",
- '/VerbatimBI' => "</i></b>",
-
-
- 'Data' => "\n",
- '/Data' => "\n",
-
- 'head1' => "\n<h1>", # And also stick in an <a name="...">
- 'head2' => "\n<h2>", # ''
- 'head3' => "\n<h3>", # ''
- 'head4' => "\n<h4>", # ''
- '/head1' => "</a></h1>\n",
- '/head2' => "</a></h2>\n",
- '/head3' => "</a></h3>\n",
- '/head4' => "</a></h4>\n",
-
- 'X' => "<!--\n\tINDEX: ",
- '/X' => "\n-->",
-
- changes(qw(
- Para=p
- B=b I=i
- over-bullet=ul
- over-number=ol
- over-text=dl
- over-block=blockquote
- item-bullet=li
- item-number=li
- item-text=dt
- )),
- changes2(
- map {; m/^([-a-z]+)/s && push @_to_accept, $1; $_ }
- qw[
- sample=samp
- definition=dfn
- kbd=keyboard
- variable=var
- citation=cite
- abbreviation=abbr
- acronym=acronym
- subscript=sub
- superscript=sup
- big=big
- small=small
- underline=u
- strikethrough=s
- ] # no point in providing a way to get <q>...</q>, I think
- ),
-
- '/item-bullet' => "</li>$LamePad\n",
- '/item-number' => "</li>$LamePad\n",
- '/item-text' => "</a></dt>$LamePad\n",
- 'item-body' => "\n<dd>",
- '/item-body' => "</dd>\n",
-
-
- 'B' => "<b>", '/B' => "</b>",
- 'I' => "<i>", '/I' => "</i>",
- 'F' => "<em$Computerese>", '/F' => "</em>",
- 'C' => "<code$Computerese>", '/C' => "</code>",
- 'L' => "<a href='YOU_SHOULD_NEVER_SEE_THIS'>", # ideally never used!
- '/L' => "</a>",
-);
-
-sub changes {
- return map {; m/^([-_:0-9a-zA-Z]+)=([-_:0-9a-zA-Z]+)$/s
- ? ( $1, => "\n<$2>", "/$1", => "</$2>\n" ) : die "Funky $_"
- } @_;
-}
-sub changes2 {
- return map {; m/^([-_:0-9a-zA-Z]+)=([-_:0-9a-zA-Z]+)$/s
- ? ( $1, => "<$2>", "/$1", => "</$2>" ) : die "Funky $_"
- } @_;
-}
-
-#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-sub go { exit Pod::Simple::HTML->parse_from_file(@ARGV) }
- # Just so we can run from the command line. No options.
- # For that, use perldoc!
-#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-sub new {
- my $new = shift->SUPER::new(@_);
- #$new->nix_X_codes(1);
- $new->nbsp_for_S(1);
- $new->accept_targets( 'html', 'HTML' );
- $new->accept_codes('VerbatimFormatted');
- $new->accept_codes(@_to_accept);
- DEBUG > 2 and print "To accept: ", join(' ',@_to_accept), "\n";
-
- $new->perldoc_url_prefix( $Perldoc_URL_Prefix );
- $new->perldoc_url_postfix( $Perldoc_URL_Postfix );
- $new->title_prefix( $Title_Prefix );
- $new->title_postfix( $Title_Postfix );
-
- $new->html_header_before_title(
- qq[$Doctype_decl<html><head><title>]
- );
- $new->html_header_after_title( join "\n" =>
- "</title>",
- $Content_decl,
- "</head>\n<body class='pod'>",
- $new->version_tag_comment,
- "<!-- start doc -->\n",
- );
- $new->html_footer( qq[\n<!-- end doc -->\n\n</body></html>\n] );
-
- $new->{'Tagmap'} = {%Tagmap};
- return $new;
-}
-
-sub batch_mode_page_object_init {
- my($self, $batchconvobj, $module, $infile, $outfile, $depth) = @_;
- DEBUG and print "Initting $self\n for $module\n",
- " in $infile\n out $outfile\n depth $depth\n";
- $self->batch_mode(1);
- $self->batch_mode_current_level($depth);
- return $self;
-}
-
-sub run {
- my $self = $_[0];
- return $self->do_middle if $self->bare_output;
- return
- $self->do_beginning && $self->do_middle && $self->do_end;
-}
-
-#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-sub do_beginning {
- my $self = $_[0];
-
- my $title;
-
- if(defined $self->force_title) {
- $title = $self->force_title;
- DEBUG and print "Forcing title to be $title\n";
- } else {
- # Actually try looking for the title in the document:
- $title = $self->get_short_title();
- unless($self->content_seen) {
- DEBUG and print "No content seen in search for title.\n";
- return;
- }
- $self->{'Title'} = $title;
-
- if(defined $title and $title =~ m/\S/) {
- $title = $self->title_prefix . esc($title) . $self->title_postfix;
- } else {
- $title = $self->default_title;
- $title = '' unless defined $title;
- DEBUG and print "Title defaults to $title\n";
- }
- }
-
-
- my $after = $self->html_header_after_title || '';
- if($self->html_css) {
- my $link =
- $self->html_css =~ m/</
- ? $self->html_css # It's a big blob of markup, let's drop it in
- : sprintf( # It's just a URL, so let's wrap it up
- qq[<link rel="stylesheet" type="text/css" title="pod_stylesheet" href="%s">\n],
- $self->html_css,
- );
- $after =~ s{(</head>)}{$link\n$1}i; # otherwise nevermind
- }
- $self->_add_top_anchor(\$after);
-
- if($self->html_javascript) {
- my $link =
- $self->html_javascript =~ m/</
- ? $self->html_javascript # It's a big blob of markup, let's drop it in
- : sprintf( # It's just a URL, so let's wrap it up
- qq[<script type="text/javascript" src="%s"></script>\n],
- $self->html_javascript,
- );
- $after =~ s{(</head>)}{$link\n$1}i; # otherwise nevermind
- }
-
- print {$self->{'output_fh'}}
- $self->html_header_before_title || '',
- $title, # already escaped
- $after,
- ;
-
- DEBUG and print "Returning from do_beginning...\n";
- return 1;
-}
-
-sub _add_top_anchor {
- my($self, $text_r) = @_;
- unless($$text_r and $$text_r =~ m/name=['"]___top['"]/) { # a hack
- $$text_r .= "<a name='___top' class='dummyTopAnchor' ></a>\n";
- }
- return;
-}
-
-sub version_tag_comment {
- my $self = shift;
- return sprintf
- "<!--\n generated by %s v%s,\n using %s v%s,\n under Perl v%s at %s GMT.\n\n %s\n\n-->\n",
- esc(
- ref($self), $self->VERSION(), $ISA[0], $ISA[0]->VERSION(),
- $], scalar(gmtime),
- ), $self->_modnote(),
- ;
-}
-
-sub _modnote {
- my $class = ref($_[0]) || $_[0];
- return join "\n " => grep m/\S/, split "\n",
-
-qq{
-If you want to change this HTML document, you probably shouldn't do that
-by changing it directly. Instead, see about changing the calling options
-to $class, and/or subclassing $class,
-then reconverting this document from the Pod source.
-When in doubt, email the author of $class for advice.
-See 'perldoc $class' for more info.
-};
-
-}
-
-sub do_end {
- my $self = $_[0];
- print {$self->{'output_fh'}} $self->html_footer || '';
- return 1;
-}
-
-# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-# Normally this would just be a call to _do_middle_main_loop -- but we
-# have to do some elaborate things to emit all the content and then
-# summarize it and output it /before/ the content that it's a summary of.
-
-sub do_middle {
- my $self = $_[0];
- return $self->_do_middle_main_loop unless $self->index;
-
- if( $self->output_string ) {
- # An efficiency hack
- my $out = $self->output_string; #it's a reference to it
- my $sneakytag = "\f\f\e\e\b\bIndex Here\e\e\b\b\f\f\n";
- $$out .= $sneakytag;
- $self->_do_middle_main_loop;
- $sneakytag = quotemeta($sneakytag);
- my $index = $self->index_as_html();
- if( $$out =~ s/$sneakytag/$index/s ) {
- # Expected case
- DEBUG and print "Inserted ", length($index), " bytes of index HTML into $out.\n";
- } else {
- DEBUG and print "Odd, couldn't find where to insert the index in the output!\n";
- # I don't think this should ever happen.
- }
- return 1;
- }
-
- unless( $self->output_fh ) {
- require Carp;
- Carp::confess("Parser object \$p doesn't seem to have any output object! I don't know how to deal with that.");
- }
-
- # If we get here, we're outputting to a FH. So we need to do some magic.
- # Namely, divert all content to a string, which we output after the index.
- my $fh = $self->output_fh;
- my $content = '';
- {
- # Our horrible bait and switch:
- $self->output_string( \$content );
- $self->_do_middle_main_loop;
- $self->abandon_output_string();
- $self->output_fh($fh);
- }
- print $fh $self->index_as_html();
- print $fh $content;
-
- return 1;
-}
-
-###########################################################################
-
-sub index_as_html {
- my $self = $_[0];
- # This is meant to be called AFTER the input document has been parsed!
-
- my $points = $self->{'PSHTML_index_points'} || [];
-
- @$points > 1 or return qq[<div class='indexgroupEmpty'></div>\n];
- # There's no point in having a 0-item or 1-item index, I dare say.
-
- my(@out) = qq{\n<div class='indexgroup'>};
- my $level = 0;
-
- my( $target_level, $previous_tagname, $tagname, $text, $anchorname, $indent);
- foreach my $p (@$points, ['head0', '(end)']) {
- ($tagname, $text) = @$p;
- $anchorname = $self->section_escape($text);
- if( $tagname =~ m{^head(\d+)$} ) {
- $target_level = 0 + $1;
- } else { # must be some kinda list item
- if($previous_tagname =~ m{^head\d+$} ) {
- $target_level = $level + 1;
- } else {
- $target_level = $level; # no change needed
- }
- }
-
- # Get to target_level by opening or closing ULs
- while($level > $target_level)
- { --$level; push @out, (" " x $level) . "</ul>"; }
- while($level < $target_level)
- { ++$level; push @out, (" " x ($level-1))
- . "<ul class='indexList indexList$level'>"; }
-
- $previous_tagname = $tagname;
- next unless $level;
-
- $indent = ' ' x $level;
- push @out, sprintf
- "%s<li class='indexItem indexItem%s'><a href='#%s'>%s</a>",
- $indent, $level, $anchorname, esc($text)
- ;
- }
- push @out, "</div>\n";
- return join "\n", @out;
-}
-
-###########################################################################
-
-sub _do_middle_main_loop {
- my $self = $_[0];
- my $fh = $self->{'output_fh'};
- my $tagmap = $self->{'Tagmap'};
-
- my($token, $type, $tagname, $linkto, $linktype);
- my @stack;
- my $dont_wrap = 0;
-
- while($token = $self->get_token) {
-
- # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
- if( ($type = $token->type) eq 'start' ) {
- if(($tagname = $token->tagname) eq 'L') {
- $linktype = $token->attr('type') || 'insane';
-
- $linkto = $self->do_link($token);
-
- if(defined $linkto and length $linkto) {
- esc($linkto);
- # (Yes, SGML-escaping applies on top of %-escaping!
- # But it's rarely noticeable in practice.)
- print $fh qq{<a href="$linkto" class="podlink$linktype"\n>};
- } else {
- print $fh "<a>"; # Yes, an 'a' element with no attributes!
- }
-
- } elsif ($tagname eq 'item-text' or $tagname =~ m/^head\d$/s) {
- print $fh $tagmap->{$tagname} || next;
-
- my @to_unget;
- while(1) {
- push @to_unget, $self->get_token;
- last if $to_unget[-1]->is_end
- and $to_unget[-1]->tagname eq $tagname;
-
- # TODO: support for X<...>'s found in here? (maybe hack into linearize_tokens)
- }
-
- my $name = $self->linearize_tokens(@to_unget);
-
- print $fh "<a ";
- print $fh "class='u' href='#___top' title='click to go to top of document'\n"
- if $tagname =~ m/^head\d$/s;
-
- if(defined $name) {
- my $esc = esc( $self->section_name_tidy( $name ) );
- print $fh qq[name="$esc"];
- DEBUG and print "Linearized ", scalar(@to_unget),
- " tokens as \"$name\".\n";
- push @{ $self->{'PSHTML_index_points'} }, [$tagname, $name]
- if $ToIndex{ $tagname };
- # Obviously, this discards all formatting codes (saving
- # just their content), but ahwell.
-
- } else { # ludicrously long, so nevermind
- DEBUG and print "Linearized ", scalar(@to_unget),
- " tokens, but it was too long, so nevermind.\n";
- }
- print $fh "\n>";
- $self->unget_token(@to_unget);
-
- } elsif ($tagname eq 'Data') {
- my $next = $self->get_token;
- next unless defined $next;
- unless( $next->type eq 'text' ) {
- $self->unget_token($next);
- next;
- }
- DEBUG and print " raw text ", $next->text, "\n";
- printf $fh "\n" . $next->text . "\n";
- next;
-
- } else {
- if( $tagname =~ m/^over-/s ) {
- push @stack, '';
- } elsif( $tagname =~ m/^item-/s and @stack and $stack[-1] ) {
- print $fh $stack[-1];
- $stack[-1] = '';
- }
- print $fh $tagmap->{$tagname} || next;
- ++$dont_wrap if $tagname eq 'Verbatim' or $tagname eq "VerbatimFormatted"
- or $tagname eq 'X';
- }
-
- # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
- } elsif( $type eq 'end' ) {
- if( ($tagname = $token->tagname) =~ m/^over-/s ) {
- if( my $end = pop @stack ) {
- print $fh $end;
- }
- } elsif( $tagname =~ m/^item-/s and @stack) {
- $stack[-1] = $tagmap->{"/$tagname"};
- if( $tagname eq 'item-text' and defined(my $next = $self->get_token) ) {
- $self->unget_token($next);
- if( $next->type eq 'start' and $next->tagname !~ m/^item-/s ) {
- print $fh $tagmap->{"/item-text"},$tagmap->{"item-body"};
- $stack[-1] = $tagmap->{"/item-body"};
- }
- }
- next;
- }
- print $fh $tagmap->{"/$tagname"} || next;
- --$dont_wrap if $tagname eq 'Verbatim' or $tagname eq 'X';
-
- # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
- } elsif( $type eq 'text' ) {
- esc($type = $token->text); # reuse $type, why not
- $type =~ s/([\?\!\"\'\.\,]) /$1\n/g unless $dont_wrap;
- print $fh $type;
- }
-
- }
- return 1;
-}
-
-###########################################################################
-#
-
-sub do_link {
- my($self, $token) = @_;
- my $type = $token->attr('type');
- if(!defined $type) {
- $self->whine("Typeless L!?", $token->attr('start_line'));
- } elsif( $type eq 'pod') { return $self->do_pod_link($token);
- } elsif( $type eq 'url') { return $self->do_url_link($token);
- } elsif( $type eq 'man') { return $self->do_man_link($token);
- } else {
- $self->whine("L of unknown type $type!?", $token->attr('start_line'));
- }
- return 'FNORG'; # should never get called
-}
-
-# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-
-sub do_url_link { return $_[1]->attr('to') }
-
-sub do_man_link { return undef }
- # But subclasses are welcome to override this if they have man
- # pages somewhere URL-accessible.
-
-
-sub do_pod_link {
- # And now things get really messy...
- my($self, $link) = @_;
- my $to = $link->attr('to');
- my $section = $link->attr('section');
- return undef unless( # should never happen
- (defined $to and length $to) or
- (defined $section and length $section)
- );
-
- $section = $self->section_escape($section)
- if defined $section and length($section .= ''); # (stringify)
-
- DEBUG and printf "Resolving \"%s\" \"%s\"...\n",
- $to || "(nil)", $section || "(nil)";
-
- {
- # An early hack:
- my $complete_url = $self->resolve_pod_link_by_table($to, $section);
- if( $complete_url ) {
- DEBUG > 1 and print "resolve_pod_link_by_table(T,S) gives ",
- $complete_url, "\n (Returning that.)\n";
- return $complete_url;
- } else {
- DEBUG > 4 and print " resolve_pod_link_by_table(T,S)",
- " didn't return anything interesting.\n";
- }
- }
-
- if(defined $to and length $to) {
- # Give this routine first hack again
- my $there = $self->resolve_pod_link_by_table($to);
- if(defined $there and length $there) {
- DEBUG > 1
- and print "resolve_pod_link_by_table(T) gives $there\n";
- } else {
- $there =
- $self->resolve_pod_page_link($to, $section);
- # (I pass it the section value, but I don't see a
- # particular reason it'd use it.)
- DEBUG > 1 and print "resolve_pod_page_link gives ", $to || "(nil)", "\n";
- unless( defined $there and length $there ) {
- DEBUG and print "Can't resolve $to\n";
- return undef;
- }
- # resolve_pod_page_link returning undef is how it
- # can signal that it gives up on making a link
- }
- $to = $there;
- }
-
- #DEBUG and print "So far [", $to||'nil', "] [", $section||'nil', "]\n";
-
- my $out = (defined $to and length $to) ? $to : '';
- $out .= "#" . $section if defined $section and length $section;
-
- unless(length $out) { # sanity check
- DEBUG and printf "Oddly, couldn't resolve \"%s\" \"%s\"...\n",
- $to || "(nil)", $section || "(nil)";
- return undef;
- }
-
- DEBUG and print "Resolved to $out\n";
- return $out;
-}
-
-
-# . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
-
-sub section_escape {
- my($self, $section) = @_;
- return $self->section_url_escape(
- $self->section_name_tidy($section)
- );
-}
-
-sub section_name_tidy {
- my($self, $section) = @_;
- $section =~ tr/ /_/;
- $section =~ tr/\x00-\x1F\x80-\x9F//d if 'A' eq chr(65); # drop crazy characters
- $section = $self->unicode_escape_url($section);
- $section = '_' unless length $section;
- return $section;
-}
-
-sub section_url_escape { shift->general_url_escape(@_) }
-sub pagepath_url_escape { shift->general_url_escape(@_) }
-
-sub general_url_escape {
- my($self, $string) = @_;
-
- $string =~ s/([^\x00-\xFF])/join '', map sprintf('%%%02X',$_), unpack 'C*', $1/eg;
- # express Unicode things as urlencode(utf(orig)).
-
- # A pretty conservative escaping, behoovey even for query components
- # of a URL (see RFC 2396)
-
- $string =~ s/([^-_\.!~*()abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789])/sprintf('%%%02X',ord($1))/eg;
- # Yes, stipulate the list without a range, so that this can work right on
- # all charsets that this module happens to run under.
- # Altho, hmm, what about that ord? Presumably that won't work right
- # under non-ASCII charsets. Something should be done
- # about that, I guess?
-
- return $string;
-}
-
-#--------------------------------------------------------------------------
-#
-# Oh look, a yawning portal to Hell! Let's play touch football right by it!
-#
-
-sub resolve_pod_page_link {
- # resolve_pod_page_link must return a properly escaped URL
- my $self = shift;
- return $self->batch_mode()
- ? $self->resolve_pod_page_link_batch_mode(@_)
- : $self->resolve_pod_page_link_singleton_mode(@_)
- ;
-}
-
-sub resolve_pod_page_link_singleton_mode {
- my($self, $it) = @_;
- return undef unless defined $it and length $it;
- my $url = $self->pagepath_url_escape($it);
-
- $url =~ s{::$}{}s; # probably never comes up anyway
- $url =~ s{::}{/}g unless $self->perldoc_url_prefix =~ m/\?/s; # sane DWIM?
-
- return undef unless length $url;
- return $self->perldoc_url_prefix . $url . $self->perldoc_url_postfix;
-}
-
-sub resolve_pod_page_link_batch_mode {
- my($self, $to) = @_;
- DEBUG > 1 and print " During batch mode, resolving $to ...\n";
- my @path = grep length($_), split m/::/s, $to, -1;
- unless( @path ) { # sanity
- DEBUG and print "Very odd! Splitting $to gives (nil)!\n";
- return undef;
- }
- $self->batch_mode_rectify_path(\@path);
- my $out = join('/', map $self->pagepath_url_escape($_), @path)
- . $HTML_EXTENSION;
- DEBUG > 1 and print " => $out\n";
- return $out;
-}
-
-sub batch_mode_rectify_path {
- my($self, $pathbits) = @_;
- my $level = $self->batch_mode_current_level;
- $level--; # how many levels up to go to get to the root
- if($level < 1) {
- unshift @$pathbits, '.'; # just to be pretty
- } else {
- unshift @$pathbits, ('..') x $level;
- }
- return;
-}
-
-#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-sub resolve_pod_link_by_table {
- # A crazy hack to allow specifying custom L<foo> => URL mappings
-
- return unless $_[0]->{'podhtml_LOT'}; # An optimizy shortcut
-
- my($self, $to, $section) = @_;
-
- # TODO: add a method that actually populates podhtml_LOT from a file?
-
- if(defined $section) {
- $to = '' unless defined $to and length $to;
- return $self->{'podhtml_LOT'}{"$to#$section"}; # quite possibly undef!
- } else {
- return $self->{'podhtml_LOT'}{$to}; # quite possibly undef!
- }
- return;
-}
-
-###########################################################################
-
-sub linearize_tokens { # self, tokens
- my $self = shift;
- my $out = '';
-
- my $t;
- while($t = shift @_) {
- if(!ref $t or !UNIVERSAL::can($t, 'is_text')) {
- $out .= $t; # a string, or some insane thing
- } elsif($t->is_text) {
- $out .= $t->text;
- } elsif($t->is_start and $t->tag eq 'X') {
- # Ignore until the end of this X<...> sequence:
- my $x_open = 1;
- while($x_open) {
- next if( ($t = shift @_)->is_text );
- if( $t->is_start and $t->tag eq 'X') { ++$x_open }
- elsif($t->is_end and $t->tag eq 'X') { --$x_open }
- }
- }
- }
- return undef if length $out > $Linearization_Limit;
- return $out;
-}
-
-#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-sub unicode_escape_url {
- my($self, $string) = @_;
- $string =~ s/([^\x00-\xFF])/'('.ord($1).')'/eg;
- # Turn char 1234 into "(1234)"
- return $string;
-}
-
-#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-sub esc { # a function.
- if(defined wantarray) {
- if(wantarray) {
- @_ = splice @_; # break aliasing
- } else {
- my $x = shift;
- $x =~ s/([^-\n\t !\#\$\%\(\)\*\+,\.\~\/\:\;=\?\@\[\\\]\^_\`\{\|\}abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789])/'&#'.(ord($1)).';'/eg;
- return $x;
- }
- }
- foreach my $x (@_) {
- # Escape things very cautiously:
- $x =~ s/([^-\n\t !\#\$\%\(\)\*\+,\.\~\/\:\;=\?\@\[\\\]\^_\`\{\|\}abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789])/'&#'.(ord($1)).';'/eg
- if defined $x;
- # Leave out "- so that "--" won't make it thru in X-generated comments
- # with text in them.
-
- # Yes, stipulate the list without a range, so that this can work right on
- # all charsets that this module happens to run under.
- # Altho, hmm, what about that ord? Presumably that won't work right
- # under non-ASCII charsets. Something should be done about that.
- }
- return @_;
-}
-
-#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-1;
-__END__
-
-=head1 NAME
-
-Pod::Simple::HTML - convert Pod to HTML
-
-=head1 SYNOPSIS
-
- perl -MPod::Simple::HTML -e Pod::Simple::HTML::go thingy.pod
-
-
-=head1 DESCRIPTION
-
-This class is for making an HTML rendering of a Pod document.
-
-This is a subclass of L<Pod::Simple::PullParser> and inherits all its
-methods (and options).
-
-Note that if you want to do a batch conversion of a lot of Pod
-documents to HTML, you should see the module L<Pod::Simple::HTMLBatch>.
-
-
-
-=head1 CALLING FROM THE COMMAND LINE
-
-TODO
-
- perl -MPod::Simple::HTML -e Pod::Simple::HTML::go Thing.pod Thing.html
-
-
-
-=head1 CALLING FROM PERL
-
-TODO make a new object, set any options, and use parse_from_file
-
-
-=head1 METHODS
-
-TODO
-all (most?) accessorized methods
-
-
-=head1 SUBCLASSING
-
-TODO
-
- can just set any of: html_css html_javascript title_prefix
- 'html_header_before_title',
- 'html_header_after_title',
- 'html_footer',
-
-maybe override do_pod_link
-
-maybe override do_beginning do_end
-
-
-
-=head1 SEE ALSO
-
-L<Pod::Simple>, L<Pod::Simple::HTMLBatch>
-
-
-TODO: a corpus of sample Pod input and HTML output? Or common
-idioms?
-
-
-
-=head1 COPYRIGHT AND DISCLAIMERS
-
-Copyright (c) 2002-2004 Sean M. Burke. All rights reserved.
-
-This library 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.
-
-=head1 AUTHOR
-
-Sean M. Burke C<sburke@cpan.org>
-
-=cut
-
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Pod/Simple/HTMLBatch.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Pod/Simple/HTMLBatch.pm
deleted file mode 100644
index bce0a44b454..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Pod/Simple/HTMLBatch.pm
+++ /dev/null
@@ -1,1342 +0,0 @@
-
-require 5;
-package Pod::Simple::HTMLBatch;
-use strict;
-use vars qw( $VERSION $HTML_RENDER_CLASS $HTML_EXTENSION
- $CSS $JAVASCRIPT $SLEEPY $SEARCH_CLASS @ISA
-);
-$VERSION = '3.02';
-@ISA = (); # Yup, we're NOT a subclass of Pod::Simple::HTML!
-
-# TODO: nocontents stylesheets. Strike some of the color variations?
-
-use Pod::Simple::HTML ();
-BEGIN {*esc = \&Pod::Simple::HTML::esc }
-use File::Spec ();
-use UNIVERSAL ();
- # "Isn't the Universe an amazing place? I wouldn't live anywhere else!"
-
-use Pod::Simple::Search;
-$SEARCH_CLASS ||= 'Pod::Simple::Search';
-
-BEGIN {
- if(defined &DEBUG) { } # no-op
- elsif( defined &Pod::Simple::DEBUG ) { *DEBUG = \&Pod::Simple::DEBUG }
- else { *DEBUG = sub () {0}; }
-}
-
-$SLEEPY = 1 if !defined $SLEEPY and $^O =~ /mswin|mac/i;
-# flag to occasionally sleep for $SLEEPY - 1 seconds.
-
-$HTML_RENDER_CLASS ||= "Pod::Simple::HTML";
-
-#
-# Methods beginning with "_" are particularly internal and possibly ugly.
-#
-
-Pod::Simple::_accessorize( __PACKAGE__,
- 'verbose', # how verbose to be during batch conversion
- 'html_render_class', # what class to use to render
- 'contents_file', # If set, should be the name of a file (in current directory)
- # to write the list of all modules to
- 'index', # will set $htmlpage->index(...) to this (true or false)
- 'progress', # progress object
- 'contents_page_start', 'contents_page_end',
-
- 'css_flurry', '_css_wad', 'javascript_flurry', '_javascript_wad',
- 'no_contents_links', # set to true to suppress automatic adding of << links.
- '_contents',
-);
-
-# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-# Just so we can run from the command line more easily
-sub go {
- @ARGV == 2 or die sprintf(
- "Usage: perl -M%s -e %s:go indirs outdir\n (or use \"\@INC\" for indirs)\n",
- __PACKAGE__, __PACKAGE__,
- );
-
- if(defined($ARGV[1]) and length($ARGV[1])) {
- my $d = $ARGV[1];
- -e $d or die "I see no output directory named \"$d\"\nAborting";
- -d $d or die "But \"$d\" isn't a directory!\nAborting";
- -w $d or die "Directory \"$d\" isn't writeable!\nAborting";
- }
-
- __PACKAGE__->batch_convert(@ARGV);
-}
-# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-
-
-sub new {
- my $new = bless {}, ref($_[0]) || $_[0];
- $new->html_render_class($HTML_RENDER_CLASS);
- $new->verbose(1 + DEBUG);
- $new->_contents([]);
-
- $new->index(1);
-
- $new-> _css_wad([]); $new->css_flurry(1);
- $new->_javascript_wad([]); $new->javascript_flurry(1);
-
- $new->contents_file(
- 'index' . ($HTML_EXTENSION || $Pod::Simple::HTML::HTML_EXTENSION)
- );
-
- $new->contents_page_start( join "\n", grep $_,
- $Pod::Simple::HTML::Doctype_decl,
- "<html><head>",
- "<title>Perl Documentation</title>",
- $Pod::Simple::HTML::Content_decl,
- "</head>",
- "\n<body class='contentspage'>\n<h1>Perl Documentation</h1>\n"
- ); # override if you need a different title
-
-
- $new->contents_page_end( sprintf(
- "\n\n<p class='contentsfooty'>Generated by %s v%s under Perl v%s\n<br >At %s GMT, which is %s local time.</p>\n\n</body></html>\n",
- esc(
- ref($new),
- eval {$new->VERSION} || $VERSION,
- $], scalar(gmtime), scalar(localtime),
- )));
-
- return $new;
-}
-
-# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-
-sub muse {
- my $self = shift;
- if($self->verbose) {
- print 'T+', int(time() - $self->{'_batch_start_time'}), "s: ", @_, "\n";
- }
- return 1;
-}
-
-# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-
-sub batch_convert {
- my($self, $dirs, $outdir) = @_;
- $self ||= __PACKAGE__; # tolerate being called as an optionless function
- $self = $self->new unless ref $self; # tolerate being used as a class method
-
- if(!defined($dirs) or $dirs eq '' or $dirs eq '@INC' ) {
- $dirs = '';
- } elsif(ref $dirs) {
- # OK, it's an explicit set of dirs to scan, specified as an arrayref.
- } else {
- # OK, it's an explicit set of dirs to scan, specified as a
- # string like "/thing:/also:/whatever/perl" (":"-delim, as usual)
- # or, under MSWin, like "c:/thing;d:/also;c:/whatever/perl" (";"-delim!)
- require Config;
- my $ps = quotemeta( $Config::Config{'path_sep'} || ":" );
- $dirs = [ grep length($_), split qr/$ps/, $dirs ];
- }
-
- $outdir = $self->filespecsys->curdir
- unless defined $outdir and length $outdir;
-
- $self->_batch_convert_main($dirs, $outdir);
-}
-
-# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-
-sub _batch_convert_main {
- my($self, $dirs, $outdir) = @_;
- # $dirs is either false, or an arrayref.
- # $outdir is a pathspec.
-
- $self->{'_batch_start_time'} ||= time();
-
- $self->muse( "= ", scalar(localtime) );
- $self->muse( "Starting batch conversion to \"$outdir\"" );
-
- my $progress = $self->progress;
- if(!$progress and $self->verbose > 0 and $self->verbose() <= 5) {
- require Pod::Simple::Progress;
- $progress = Pod::Simple::Progress->new(
- ($self->verbose < 2) ? () # Default omission-delay
- : ($self->verbose == 2) ? 1 # Reduce the omission-delay
- : 0 # Eliminate the omission-delay
- );
- $self->progress($progress);
- }
-
- if($dirs) {
- $self->muse(scalar(@$dirs), " dirs to scan: @$dirs");
- } else {
- $self->muse("Scanning \@INC. This could take a minute or two.");
- }
- my $mod2path = $self->find_all_pods($dirs ? $dirs : ());
- $self->muse("Done scanning.");
-
- my $total = keys %$mod2path;
- unless($total) {
- $self->muse("No pod found. Aborting batch conversion.\n");
- return $self;
- }
-
- $progress and $progress->goal($total);
- $self->muse("Now converting pod files to HTML.",
- ($total > 25) ? " This will take a while more." : ()
- );
-
- $self->_spray_css( $outdir );
- $self->_spray_javascript( $outdir );
-
- $self->_do_all_batch_conversions($mod2path, $outdir);
-
- $progress and $progress->done(sprintf (
- "Done converting %d files.", $self->{"__batch_conv_page_count"}
- ));
- return $self->_batch_convert_finish($outdir);
- return $self;
-}
-
-
-sub _do_all_batch_conversions {
- my($self, $mod2path, $outdir) = @_;
- $self->{"__batch_conv_page_count"} = 0;
-
- foreach my $module (sort {lc($a) cmp lc($b)} keys %$mod2path) {
- $self->_do_one_batch_conversion($module, $mod2path, $outdir);
- sleep($SLEEPY - 1) if $SLEEPY;
- }
-
- return;
-}
-
-sub _batch_convert_finish {
- my($self, $outdir) = @_;
- $self->write_contents_file($outdir);
- $self->muse("Done with batch conversion. $$self{'__batch_conv_page_count'} files done.");
- $self->muse( "= ", scalar(localtime) );
- $self->progress and $self->progress->done("All done!");
- return;
-}
-
-# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-
-sub _do_one_batch_conversion {
- my($self, $module, $mod2path, $outdir, $outfile) = @_;
-
- my $retval;
- my $total = scalar keys %$mod2path;
- my $infile = $mod2path->{$module};
- my @namelets = grep m/\S/, split "::", $module;
- # this can stick around in the contents LoL
- my $depth = scalar @namelets;
- die "Contentless thingie?! $module $infile" unless @namelets; #sanity
-
- $outfile ||= do {
- my @n = @namelets;
- $n[-1] .= $HTML_EXTENSION || $Pod::Simple::HTML::HTML_EXTENSION;
- $self->filespecsys->catfile( $outdir, @n );
- };
-
- my $progress = $self->progress;
-
- my $page = $self->html_render_class->new;
- if(DEBUG > 5) {
- $self->muse($self->{"__batch_conv_page_count"} + 1, "/$total: ",
- ref($page), " render ($depth) $module => $outfile");
- } elsif(DEBUG > 2) {
- $self->muse($self->{"__batch_conv_page_count"} + 1, "/$total: $module => $outfile")
- }
-
- # Give each class a chance to init the converter:
-
- $page->batch_mode_page_object_init($self, $module, $infile, $outfile, $depth)
- if $page->can('batch_mode_page_object_init');
- $self->batch_mode_page_object_init($page, $module, $infile, $outfile, $depth)
- if $self->can('batch_mode_page_object_init');
-
- # Now get busy...
- $self->makepath($outdir => \@namelets);
-
- $progress and $progress->reach($self->{"__batch_conv_page_count"}, "Rendering $module");
-
- if( $retval = $page->parse_from_file($infile, $outfile) ) {
- ++ $self->{"__batch_conv_page_count"} ;
- $self->note_for_contents_file( \@namelets, $infile, $outfile );
- } else {
- $self->muse("Odd, parse_from_file(\"$infile\", \"$outfile\") returned false.");
- }
-
- $page->batch_mode_page_object_kill($self, $module, $infile, $outfile, $depth)
- if $page->can('batch_mode_page_object_kill');
- # The following isn't a typo. Note that it switches $self and $page.
- $self->batch_mode_page_object_kill($page, $module, $infile, $outfile, $depth)
- if $self->can('batch_mode_page_object_kill');
-
- DEBUG > 4 and printf "%s %sb < $infile %s %sb\n",
- $outfile, -s $outfile, $infile, -s $infile
- ;
-
- undef($page);
- return $retval;
-}
-
-# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-sub filespecsys { $_[0]{'_filespecsys'} || 'File::Spec' }
-
-# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-
-sub note_for_contents_file {
- my($self, $namelets, $infile, $outfile) = @_;
-
- # I think the infile and outfile parts are never used. -- SMB
- # But it's handy to have them around for debugging.
-
- if( $self->contents_file ) {
- my $c = $self->_contents();
- push @$c,
- [ join("::", @$namelets), $infile, $outfile, $namelets ]
- # 0 1 2 3
- ;
- DEBUG > 3 and print "Noting @$c[-1]\n";
- }
- return;
-}
-
-#_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-
-
-sub write_contents_file {
- my($self, $outdir) = @_;
- my $outfile = $self->_contents_filespec($outdir) || return;
-
- $self->muse("Preparing list of modules for ToC");
-
- my($toplevel, # maps toplevelbit => [all submodules]
- $toplevel_form_freq, # ends up being 'foo' => 'Foo'
- ) = $self->_prep_contents_breakdown;
-
- my $Contents = eval { $self->_wopen($outfile) };
- if( $Contents ) {
- $self->muse( "Writing contents file $outfile" );
- } else {
- warn "Couldn't write-open contents file $outfile: $!\nAbort writing to $outfile at all";
- return;
- }
-
- $self->_write_contents_start( $Contents, $outfile, );
- $self->_write_contents_middle( $Contents, $outfile, $toplevel, $toplevel_form_freq );
- $self->_write_contents_end( $Contents, $outfile, );
- return $outfile;
-}
-
-# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-
-sub _write_contents_start {
- my($self, $Contents, $outfile) = @_;
- my $starter = $self->contents_page_start || '';
-
- {
- my $css_wad = $self->_css_wad_to_markup(1);
- if( $css_wad ) {
- $starter =~ s{(</head>)}{\n$css_wad\n$1}i; # otherwise nevermind
- }
-
- my $javascript_wad = $self->_javascript_wad_to_markup(1);
- if( $javascript_wad ) {
- $starter =~ s{(</head>)}{\n$javascript_wad\n$1}i; # otherwise nevermind
- }
- }
-
- unless(print $Contents $starter, "<dl class='superindex'>\n" ) {
- warn "Couldn't print to $outfile: $!\nAbort writing to $outfile at all";
- close($Contents);
- return 0;
- }
- return 1;
-}
-
-# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-
-sub _write_contents_middle {
- my($self, $Contents, $outfile, $toplevel2submodules, $toplevel_form_freq) = @_;
-
- foreach my $t (sort keys %$toplevel2submodules) {
- my @downlines = sort {$a->[-1] cmp $b->[-1]}
- @{ $toplevel2submodules->{$t} };
-
- printf $Contents qq[<dt><a name="%s">%s</a></dt>\n<dd>\n],
- esc( $t, $toplevel_form_freq->{$t} )
- ;
-
- my($path, $name);
- foreach my $e (@downlines) {
- $name = $e->[0];
- $path = join( "/", '.', esc( @{$e->[3]} ) )
- . ($HTML_EXTENSION || $Pod::Simple::HTML::HTML_EXTENSION);
- print $Contents qq{ <a href="$path">}, esc($name), "</a>&nbsp;&nbsp;\n";
- }
- print $Contents "</dd>\n\n";
- }
- return 1;
-}
-
-# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-
-sub _write_contents_end {
- my($self, $Contents, $outfile) = @_;
- unless(
- print $Contents "</dl>\n",
- $self->contents_page_end || '',
- ) {
- warn "Couldn't write to $outfile: $!";
- }
- close($Contents) or warn "Couldn't close $outfile: $!";
- return 1;
-}
-
-# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-
-sub _prep_contents_breakdown {
- my($self) = @_;
- my $contents = $self->_contents;
- my %toplevel; # maps lctoplevelbit => [all submodules]
- my %toplevel_form_freq; # ends up being 'foo' => 'Foo'
- # (mapping anycase forms to most freq form)
-
- foreach my $entry (@$contents) {
- my $toplevel =
- $entry->[0] =~ m/^perl\w*$/ ? 'perl_core_docs'
- # group all the perlwhatever docs together
- : $entry->[3][0] # normal case
- ;
- ++$toplevel_form_freq{ lc $toplevel }{ $toplevel };
- push @{ $toplevel{ lc $toplevel } }, $entry;
- push @$entry, lc($entry->[0]); # add a sort-order key to the end
- }
-
- foreach my $toplevel (sort keys %toplevel) {
- my $fgroup = $toplevel_form_freq{$toplevel};
- $toplevel_form_freq{$toplevel} =
- (
- sort { $fgroup->{$b} <=> $fgroup->{$a} or $a cmp $b }
- keys %$fgroup
- # This hash is extremely unlikely to have more than 4 members, so this
- # sort isn't so very wasteful
- )[0];
- }
-
- return(\%toplevel, \%toplevel_form_freq) if wantarray;
- return \%toplevel;
-}
-
-# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-
-sub _contents_filespec {
- my($self, $outdir) = @_;
- my $outfile = $self->contents_file;
- return unless $outfile;
- return $self->filespecsys->catfile( $outdir, $outfile );
-}
-
-#_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-
-
-sub makepath {
- my($self, $outdir, $namelets) = @_;
- return unless @$namelets > 1;
- for my $i (0 .. ($#$namelets - 1)) {
- my $dir = $self->filespecsys->catdir( $outdir, @$namelets[0 .. $i] );
- if(-e $dir) {
- die "$dir exists but not as a directory!?" unless -d $dir;
- next;
- }
- DEBUG > 3 and print " Making $dir\n";
- mkdir $dir, 0777
- or die "Can't mkdir $dir: $!\nAborting"
- ;
- }
- return;
-}
-
-#_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-
-
-sub batch_mode_page_object_init {
- my $self = shift;
- my($page, $module, $infile, $outfile, $depth) = @_;
-
- # TODO: any further options to percolate onto this new object here?
-
- $page->default_title($module);
- $page->index( $self->index );
-
- $page->html_css( $self-> _css_wad_to_markup($depth) );
- $page->html_javascript( $self->_javascript_wad_to_markup($depth) );
-
- $self->add_header_backlink($page, $module, $infile, $outfile, $depth);
- $self->add_footer_backlink($page, $module, $infile, $outfile, $depth);
-
-
- return $self;
-}
-
-# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-
-sub add_header_backlink {
- my $self = shift;
- return if $self->no_contents_links;
- my($page, $module, $infile, $outfile, $depth) = @_;
- $page->html_header_after_title( join '',
- $page->html_header_after_title || '',
-
- qq[<p class="backlinktop"><b><a name="___top" href="],
- $self->url_up_to_contents($depth),
- qq[" accesskey="1" title="All Documents">&lt;&lt;</a></b></p>\n],
- )
- if $self->contents_file
- ;
- return;
-}
-
-sub add_footer_backlink {
- my $self = shift;
- return if $self->no_contents_links;
- my($page, $module, $infile, $outfile, $depth) = @_;
- $page->html_footer( join '',
- qq[<p class="backlinkbottom"><b><a name="___bottom" href="],
- $self->url_up_to_contents($depth),
- qq[" title="All Documents">&lt;&lt;</a></b></p>\n],
-
- $page->html_footer || '',
- )
- if $self->contents_file
- ;
- return;
-}
-
-sub url_up_to_contents {
- my($self, $depth) = @_;
- --$depth;
- return join '/', ('..') x $depth, esc($self->contents_file);
-}
-
-#_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-
-
-sub find_all_pods {
- my($self, $dirs) = @_;
- # You can override find_all_pods in a subclass if you want to
- # do extra filtering or whatnot. But for the moment, we just
- # pass to modnames2paths:
- return $self->modnames2paths($dirs);
-}
-
-#_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-
-
-sub modnames2paths { # return a hashref mapping modulenames => paths
- my($self, $dirs) = @_;
-
- my $m2p;
- {
- my $search = $SEARCH_CLASS->new;
- DEBUG and print "Searching via $search\n";
- $search->verbose(1) if DEBUG > 10;
- $search->progress( $self->progress->copy->goal(0) ) if $self->progress;
- $search->shadows(0); # don't bother noting shadowed files
- $search->inc( $dirs ? 0 : 1 );
- $search->survey( $dirs ? @$dirs : () );
- $m2p = $search->name2path;
- die "What, no name2path?!" unless $m2p;
- }
-
- $self->muse("That's odd... no modules found!") unless keys %$m2p;
- if( DEBUG > 4 ) {
- print "Modules found (name => path):\n";
- foreach my $m (sort {lc($a) cmp lc($b)} keys %$m2p) {
- print " $m $$m2p{$m}\n";
- }
- print "(total ", scalar(keys %$m2p), ")\n\n";
- } elsif( DEBUG ) {
- print "Found ", scalar(keys %$m2p), " modules.\n";
- }
- $self->muse( "Found ", scalar(keys %$m2p), " modules." );
-
- # return the Foo::Bar => /whatever/Foo/Bar.pod|pm hashref
- return $m2p;
-}
-
-#===========================================================================
-
-sub _wopen {
- # this is abstracted out so that the daemon class can override it
- my($self, $outpath) = @_;
- require Symbol;
- my $out_fh = Symbol::gensym();
- DEBUG > 5 and print "Write-opening to $outpath\n";
- return $out_fh if open($out_fh, "> $outpath");
- require Carp;
- Carp::croak("Can't write-open $outpath: $!");
-}
-
-#==========================================================================
-
-sub add_css {
- my($self, $url, $is_default, $name, $content_type, $media, $_code) = @_;
- return unless $url;
- unless($name) {
- # cook up a reasonable name based on the URL
- $name = $url;
- if( $name !~ m/\?/ and $name =~ m{([^/]+)$}s ) {
- $name = $1;
- $name =~ s/\.css//i;
- }
- }
- $media ||= 'all';
- $content_type ||= 'text/css';
-
- my $bunch = [$url, $name, $content_type, $media, $_code];
- if($is_default) { unshift @{ $self->_css_wad }, $bunch }
- else { push @{ $self->_css_wad }, $bunch }
- return;
-}
-
-# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-
-sub _spray_css {
- my($self, $outdir) = @_;
-
- return unless $self->css_flurry();
- $self->_gen_css_wad();
-
- my $lol = $self->_css_wad;
- foreach my $chunk (@$lol) {
- my $url = $chunk->[0];
- my $outfile;
- if( ref($chunk->[-1]) and $url =~ m{^(_[-a-z0-9_]+\.css$)} ) {
- $outfile = $self->filespecsys->catfile( $outdir, $1 );
- DEBUG > 5 and print "Noting $$chunk[0] as a file I'll create.\n";
- } else {
- DEBUG > 5 and print "OK, noting $$chunk[0] as an external CSS.\n";
- # Requires no further attention.
- next;
- }
-
- #$self->muse( "Writing autogenerated CSS file $outfile" );
- my $Cssout = $self->_wopen($outfile);
- print $Cssout ${$chunk->[-1]}
- or warn "Couldn't print to $outfile: $!\nAbort writing to $outfile at all";
- close($Cssout);
- DEBUG > 5 and print "Wrote $outfile\n";
- }
-
- return;
-}
-
-# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-
-sub _css_wad_to_markup {
- my($self, $depth) = @_;
-
- my @css = @{ $self->_css_wad || return '' };
- return '' unless @css;
-
- my $rel = 'stylesheet';
- my $out = '';
-
- --$depth;
- my $uplink = $depth ? ('../' x $depth) : '';
-
- foreach my $chunk (@css) {
- next unless $chunk and @$chunk;
-
- my( $url1, $url2, $title, $type, $media) = (
- $self->_maybe_uplink( $chunk->[0], $uplink ),
- esc(grep !ref($_), @$chunk)
- );
-
- $out .= qq{<link rel="$rel" title="$title" type="$type" href="$url1$url2" media="$media" >\n};
-
- $rel = 'alternate stylesheet'; # alternates = all non-first iterations
- }
- return $out;
-}
-
-# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-sub _maybe_uplink {
- # if the given URL looks relative, return the given uplink string --
- # otherwise return emptystring
- my($self, $url, $uplink) = @_;
- ($url =~ m{^\./} or $url !~ m{[/\:]} )
- ? $uplink
- : ''
- # qualify it, if/as needed
-}
-
-# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-sub _gen_css_wad {
- my $self = $_[0];
- my $css_template = $self->_css_template;
- foreach my $variation (
-
- # Commented out for sake of concision:
- #
- # 011n=black_with_red_on_white
- # 001n=black_with_yellow_on_white
- # 101n=black_with_green_on_white
- # 110=white_with_yellow_on_black
- # 010=white_with_green_on_black
- # 011=white_with_blue_on_black
- # 100=white_with_red_on_black
-
- qw[
- 110n=black_with_blue_on_white
- 010n=black_with_magenta_on_white
- 100n=black_with_cyan_on_white
-
- 101=white_with_purple_on_black
- 001=white_with_navy_blue_on_black
-
- 010a=grey_with_green_on_black
- 010b=white_with_green_on_grey
- 101an=black_with_green_on_grey
- 101bn=grey_with_green_on_white
- ]) {
-
- my $outname = $variation;
- my($flipmode, @swap) = ( ($4 || ''), $1,$2,$3)
- if $outname =~ s/^([012])([012])([[012])([a-z]*)=?//s;
- @swap = () if '010' eq join '', @swap; # 010 is a swop-no-op!
-
- my $this_css =
- "/* This file is autogenerated. Do not edit. $variation */\n\n"
- . $css_template;
-
- # Only look at three-digitty colors, for now at least.
- if( $flipmode =~ m/n/ ) {
- $this_css =~ s/(#[0-9a-fA-F]{3})\b/_color_negate($1)/eg;
- $this_css =~ s/\bthin\b/medium/g;
- }
- $this_css =~ s<#([0-9a-fA-F])([0-9a-fA-F])([0-9a-fA-F])\b>
- < join '', '#', ($1,$2,$3)[@swap] >eg if @swap;
-
- if( $flipmode =~ m/a/)
- { $this_css =~ s/#fff\b/#999/gi } # black -> dark grey
- elsif($flipmode =~ m/b/)
- { $this_css =~ s/#000\b/#666/gi } # white -> light grey
-
- my $name = $outname;
- $name =~ tr/-_/ /;
- $self->add_css( "_$outname.css", 0, $name, 0, 0, \$this_css);
- }
-
- # Now a few indexless variations:
- foreach my $variation (qw[
- black_with_blue_on_white white_with_purple_on_black
- white_with_green_on_grey grey_with_green_on_white
- ]) {
- my $outname = "indexless_$variation";
- my $this_css = join "\n",
- "/* This file is autogenerated. Do not edit. $outname */\n",
- "\@import url(\"./_$variation.css\");",
- ".indexgroup { display: none; }",
- "\n",
- ;
- my $name = $outname;
- $name =~ tr/-_/ /;
- $self->add_css( "_$outname.css", 0, $name, 0, 0, \$this_css);
- }
-
- return;
-}
-
-sub _color_negate {
- my $x = lc $_[0];
- $x =~ tr[0123456789abcdef]
- [fedcba9876543210];
- return $x;
-}
-
-#===========================================================================
-
-sub add_javascript {
- my($self, $url, $content_type, $_code) = @_;
- return unless $url;
- push @{ $self->_javascript_wad }, [
- $url, $content_type || 'text/javascript', $_code
- ];
- return;
-}
-
-sub _spray_javascript {
- my($self, $outdir) = @_;
- return unless $self->javascript_flurry();
- $self->_gen_javascript_wad();
-
- my $lol = $self->_javascript_wad;
- foreach my $script (@$lol) {
- my $url = $script->[0];
- my $outfile;
-
- if( ref($script->[-1]) and $url =~ m{^(_[-a-z0-9_]+\.js$)} ) {
- $outfile = $self->filespecsys->catfile( $outdir, $1 );
- DEBUG > 5 and print "Noting $$script[0] as a file I'll create.\n";
- } else {
- DEBUG > 5 and print "OK, noting $$script[0] as an external JavaScript.\n";
- next;
- }
-
- #$self->muse( "Writing JavaScript file $outfile" );
- my $Jsout = $self->_wopen($outfile);
-
- print $Jsout ${$script->[-1]}
- or warn "Couldn't print to $outfile: $!\nAbort writing to $outfile at all";
- close($Jsout);
- DEBUG > 5 and print "Wrote $outfile\n";
- }
-
- return;
-}
-
-sub _gen_javascript_wad {
- my $self = $_[0];
- my $js_code = $self->_javascript || return;
- $self->add_javascript( "_podly.js", 0, \$js_code);
- return;
-}
-
-sub _javascript_wad_to_markup {
- my($self, $depth) = @_;
-
- my @scripts = @{ $self->_javascript_wad || return '' };
- return '' unless @scripts;
-
- my $out = '';
-
- --$depth;
- my $uplink = $depth ? ('../' x $depth) : '';
-
- foreach my $s (@scripts) {
- next unless $s and @$s;
-
- my( $url1, $url2, $type, $media) = (
- $self->_maybe_uplink( $s->[0], $uplink ),
- esc(grep !ref($_), @$s)
- );
-
- $out .= qq{<script type="$type" src="$url1$url2"></script>\n};
- }
- return $out;
-}
-
-#===========================================================================
-
-sub _css_template { return $CSS }
-sub _javascript { return $JAVASCRIPT }
-
-$CSS = <<'EOCSS';
-/* For accessibility reasons, never specify text sizes in px/pt/pc/in/cm/mm */
-
-@media all { .hide { display: none; } }
-
-@media print {
- .noprint, div.indexgroup, .backlinktop, .backlinkbottom { display: none }
-
- * {
- border-color: black !important;
- color: black !important;
- background-color: transparent !important;
- background-image: none !important;
- }
-
- dl.superindex > dd {
- word-spacing: .6em;
- }
-}
-
-@media aural, braille, embossed {
- div.indexgroup { display: none; } /* Too noisy, don't you think? */
- dl.superindex > dt:before { content: "Group "; }
- dl.superindex > dt:after { content: " contains:"; }
- .backlinktop a:before { content: "Back to contents"; }
- .backlinkbottom a:before { content: "Back to contents"; }
-}
-
-@media aural {
- dl.superindex > dt { pause-before: 600ms; }
-}
-
-@media screen, tty, tv, projection {
- .noscreen { display: none; }
-
- a:link { color: #7070ff; text-decoration: underline; }
- a:visited { color: #e030ff; text-decoration: underline; }
- a:active { color: #800000; text-decoration: underline; }
- body.contentspage a { text-decoration: none; }
- a.u { color: #fff !important; text-decoration: none; }
-
- body.pod {
- margin: 0 5px;
- color: #fff;
- background-color: #000;
- }
-
- body.pod h1, body.pod h2, body.pod h3, body.pod h4 {
- font-family: Tahoma, Verdana, Helvetica, Arial, sans-serif;
- font-weight: normal;
- margin-top: 1.2em;
- margin-bottom: .1em;
- border-top: thin solid transparent;
- /* margin-left: -5px; border-left: 2px #7070ff solid; padding-left: 3px; */
- }
-
- body.pod h1 { border-top-color: #0a0; }
- body.pod h2 { border-top-color: #080; }
- body.pod h3 { border-top-color: #040; }
- body.pod h4 { border-top-color: #010; }
-
- p.backlinktop + h1 { border-top: none; margin-top: 0em; }
- p.backlinktop + h2 { border-top: none; margin-top: 0em; }
- p.backlinktop + h3 { border-top: none; margin-top: 0em; }
- p.backlinktop + h4 { border-top: none; margin-top: 0em; }
-
- body.pod dt {
- font-size: 105%; /* just a wee bit more than normal */
- }
-
- .indexgroup { font-size: 80%; }
-
- .backlinktop, .backlinkbottom {
- margin-left: -5px;
- margin-right: -5px;
- background-color: #040;
- border-top: thin solid #050;
- border-bottom: thin solid #050;
- }
-
- .backlinktop a, .backlinkbottom a {
- text-decoration: none;
- color: #080;
- background-color: #000;
- border: thin solid #0d0;
- }
- .backlinkbottom { margin-bottom: 0; padding-bottom: 0; }
- .backlinktop { margin-top: 0; padding-top: 0; }
-
- body.contentspage {
- color: #fff;
- background-color: #000;
- }
-
- body.contentspage h1 {
- color: #0d0;
- margin-left: 1em;
- margin-right: 1em;
- text-indent: -.9em;
- font-family: Tahoma, Verdana, Helvetica, Arial, sans-serif;
- font-weight: normal;
- border-top: thin solid #fff;
- border-bottom: thin solid #fff;
- text-align: center;
- }
-
- dl.superindex > dt {
- font-family: Tahoma, Verdana, Helvetica, Arial, sans-serif;
- font-weight: normal;
- font-size: 90%;
- margin-top: .45em;
- /* margin-bottom: -.15em; */
- }
- dl.superindex > dd {
- word-spacing: .6em; /* most important rule here! */
- }
- dl.superindex > a:link {
- text-decoration: none;
- color: #fff;
- }
-
- .contentsfooty {
- border-top: thin solid #999;
- font-size: 90%;
- }
-
-}
-
-/* The End */
-
-EOCSS
-
-#==========================================================================
-
-$JAVASCRIPT = <<'EOJAVASCRIPT';
-
-// From http://www.alistapart.com/articles/alternate/
-
-function setActiveStyleSheet(title) {
- var i, a, main;
- for(i=0 ; (a = document.getElementsByTagName("link")[i]) ; i++) {
- if(a.getAttribute("rel").indexOf("style") != -1 && a.getAttribute("title")) {
- a.disabled = true;
- if(a.getAttribute("title") == title) a.disabled = false;
- }
- }
-}
-
-function getActiveStyleSheet() {
- var i, a;
- for(i=0 ; (a = document.getElementsByTagName("link")[i]) ; i++) {
- if( a.getAttribute("rel").indexOf("style") != -1
- && a.getAttribute("title")
- && !a.disabled
- ) return a.getAttribute("title");
- }
- return null;
-}
-
-function getPreferredStyleSheet() {
- var i, a;
- for(i=0 ; (a = document.getElementsByTagName("link")[i]) ; i++) {
- if( a.getAttribute("rel").indexOf("style") != -1
- && a.getAttribute("rel").indexOf("alt") == -1
- && a.getAttribute("title")
- ) return a.getAttribute("title");
- }
- return null;
-}
-
-function createCookie(name,value,days) {
- if (days) {
- var date = new Date();
- date.setTime(date.getTime()+(days*24*60*60*1000));
- var expires = "; expires="+date.toGMTString();
- }
- else expires = "";
- document.cookie = name+"="+value+expires+"; path=/";
-}
-
-function readCookie(name) {
- var nameEQ = name + "=";
- var ca = document.cookie.split(';');
- for(var i=0 ; i < ca.length ; i++) {
- var c = ca[i];
- while (c.charAt(0)==' ') c = c.substring(1,c.length);
- if (c.indexOf(nameEQ) == 0) return c.substring(nameEQ.length,c.length);
- }
- return null;
-}
-
-window.onload = function(e) {
- var cookie = readCookie("style");
- var title = cookie ? cookie : getPreferredStyleSheet();
- setActiveStyleSheet(title);
-}
-
-window.onunload = function(e) {
- var title = getActiveStyleSheet();
- createCookie("style", title, 365);
-}
-
-var cookie = readCookie("style");
-var title = cookie ? cookie : getPreferredStyleSheet();
-setActiveStyleSheet(title);
-
-// The End
-
-EOJAVASCRIPT
-
-# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-1;
-__END__
-
-
-=head1 NAME
-
-Pod::Simple::HTMLBatch - convert several Pod files to several HTML files
-
-=head1 SYNOPSIS
-
- perl -MPod::Simple::HTMLBatch -e 'Pod::Simple::HTMLBatch::go' in out
-
-
-=head1 DESCRIPTION
-
-This module is used for running batch-conversions of a lot of HTML
-documents
-
-This class is NOT a subclass of Pod::Simple::HTML
-(nor of bad old Pod::Html) -- although it uses
-Pod::Simple::HTML for doing the conversion of each document.
-
-The normal use of this class is like so:
-
- use Pod::Simple::HTMLBatch;
- my $batchconv = Pod::Simple::HTMLBatch->new;
- $batchconv->some_option( some_value );
- $batchconv->some_other_option( some_other_value );
- $batchconv->batch_convert( \@search_dirs, $output_dir );
-
-=head2 FROM THE COMMAND LINE
-
-Note that this class also provides
-(but does not export) the function Pod::Simple::HTMLBatch::go.
-This is basically just a shortcut for C<<
-Pod::Simple::HTMLBatch->batch_convert(@ARGV) >>.
-It's meant to be handy for calling from the command line.
-
-However, the shortcut requires that you specify exactly two command-line
-arguments, C<indirs> and C<outdir>.
-
-Example:
-
- % mkdir out_html
- % perl -MPod::Simple::HTMLBatch -e Pod::Simple::HTMLBatch::go @INC out_html
- (to convert the pod from Perl's @INC
- files under the directory ../htmlversion)
-
-(Note that the command line there contains a literal atsign-I-N-C. This
-is handled as a special case by batch_convert, in order to save you having
-to enter the odd-looking "" as the first command-line parameter when you
-mean "just use whatever's in @INC".)
-
-Example:
-
- % mkdir ../seekrut
- % chmod og-rx ../seekrut
- % perl -MPod::Simple::HTMLBatch -e Pod::Simple::HTMLBatch::go . ../htmlversion
- (to convert the pod under the current dir into HTML
- files under the directory ../htmlversion)
-
-Example:
-
- % perl -MPod::Simple::HTMLBatch -e Pod::Simple::HTMLBatch::go happydocs .
- (to convert all pod from happydocs into the current directory)
-
-
-
-=head1 MAIN METHODS
-
-=over
-
-=item $batchconv = Pod::Simple::HTMLBatch->new;
-
-This TODO
-
-
-=item $batchconv->batch_convert( I<indirs>, I<outdir> );
-
-this TODO
-
-=item $batchconv->batch_convert( undef , ...);
-
-=item $batchconv->batch_convert( q{@INC}, ...);
-
-These two values for I<indirs> specify that the normal Perl @INC
-
-=item $batchconv->batch_convert( \@dirs , ...);
-
-This specifies that the input directories are the items in
-the arrayref C<\@dirs>.
-
-=item $batchconv->batch_convert( "somedir" , ...);
-
-This specifies that the director "somedir" is the input.
-(This can be an absolute or relative path, it doesn't matter.)
-
-A common value you might want would be just "." for the current
-directory:
-
- $batchconv->batch_convert( "." , ...);
-
-
-=item $batchconv->batch_convert( 'somedir:someother:also' , ...);
-
-This specifies that you want the dirs "somedir", "somother", and "also"
-scanned, just as if you'd passed the arrayref
-C<[qw( somedir someother also)]>. Note that a ":"-separator is normal
-under Unix, but Under MSWin, you'll need C<'somedir;someother;also'>
-instead, since the pathsep on MSWin is ";" instead of ":". (And
-I<that> is because ":" often comes up in paths, like
-C<"c:/perl/lib">.)
-
-(Exactly what separator character should be used, is gotten from
-C<$Config::Config{'path_sep'}>, via the L<Config> module.)
-
-=item $batchconv->batch_convert( ... , undef );
-
-This specifies that you want the HTML output to go into the current
-directory.
-
-(Note that a missing or undefined value means a different thing in
-the first slot than in the second. That's so that C<batch_convert()>
-with no arguments (or undef arguments) means "go from @INC, into
-the current directory.)
-
-=item $batchconv->batch_convert( ... , 'somedir' );
-
-This specifies that you want the HTML output to go into the
-directory 'somedir'.
-(This can be an absolute or relative path, it doesn't matter.)
-
-=back
-
-
-Note that you can also call C<batch_convert> as a class method,
-like so:
-
- Pod::Simple::HTMLBatch->batch_convert( ... );
-
-That is just short for this:
-
- Pod::Simple::HTMLBatch-> new-> batch_convert(...);
-
-That is, it runs a conversion with default options, for
-whatever inputdirs and output dir you specify.
-
-
-=head2 ACCESSOR METHODS
-
-The following are all accessor methods -- that is, they don't do anything
-on their own, but just alter the contents of the conversion object,
-which comprises the options for this particular batch conversion.
-
-We show the "put" form of the accessors below (i.e., the syntax you use
-for setting the accessor to a specific value). But you can also
-call each method with no parameters to get its current value. For
-example, C<< $self->contents_file() >> returns the current value of
-the contents_file attribute.
-
-=over
-
-
-=item $batchconv->verbose( I<nonnegative_integer> );
-
-This controls how verbose to be during batch conversion, as far as
-notes to STDOUT (or whatever is C<select>'d) about how the conversion
-is going. If 0, no progress information is printed.
-If 1 (the default value), some progress information is printed.
-Higher values print more information.
-
-
-=item $batchconv->index( I<true-or-false> );
-
-This controls whether or not each HTML page is liable to have a little
-table of contents at the top (which we call an "index" for historical
-reasons). This is true by default.
-
-
-=item $batchconv->contents_file( I<filename> );
-
-If set, should be the name of a file (in the output directory)
-to write the HTML index to. The default value is "index.html".
-If you set this to a false value, no contents file will be written.
-
-=item $batchconv->contents_page_start( I<HTML_string> );
-
-This specifies what string should be put at the beginning of
-the contents page.
-The default is a string more or less like this:
-
- <html>
- <head><title>Perl Documentation</title></head>
- <body class='contentspage'>
- <h1>Perl Documentation</h1>
-
-=item $batchconv->contents_page_end( I<HTML_string> );
-
-This specifies what string should be put at the end of the contents page.
-The default is a string more or less like this:
-
- <p class='contentsfooty'>Generated by
- Pod::Simple::HTMLBatch v3.01 under Perl v5.008
- <br >At Fri May 14 22:26:42 2004 GMT,
- which is Fri May 14 14:26:42 2004 local time.</p>
-
-
-
-=item $batchconv->add_css( $url );
-
-TODO
-
-=item $batchconv->add_javascript( $url );
-
-TODO
-
-=item $batchconv->css_flurry( I<true-or-false> );
-
-If true (the default value), we autogenerate some CSS files in the
-output directory, and set our HTML files to use those.
-TODO: continue
-
-=item $batchconv->javascript_flurry( I<true-or-false> );
-
-If true (the default value), we autogenerate a JavaScript in the
-output directory, and set our HTML files to use it. Currently,
-the JavaScript is used only to get the browser to remember what
-stylesheet it prefers.
-TODO: continue
-
-=item $batchconv->no_contents_links( I<true-or-false> );
-
-TODO
-
-=item $batchconv->html_render_class( I<classname> );
-
-This sets what class is used for rendering the files.
-The default is "Pod::Simple::Search". If you set it to something else,
-it should probably be a subclass of Pod::Simple::Search, and you should
-C<require> or C<use> that class so that's it's loaded before
-Pod::Simple::HTMLBatch tries loading it.
-
-=back
-
-
-
-
-=head1 NOTES ON CUSTOMIZATION
-
-TODO
-
- call add_css($someurl) to add stylesheet as alternate
- call add_css($someurl,1) to add as primary stylesheet
-
- call add_javascript
-
- subclass Pod::Simple::HTML and set $batchconv->html_render_class to
- that classname
- and maybe override
- $page->batch_mode_page_object_init($self, $module, $infile, $outfile, $depth)
- or maybe override
- $batchconv->batch_mode_page_object_init($page, $module, $infile, $outfile, $depth)
-
-
-
-=head1 ASK ME!
-
-If you want to do some kind of big pod-to-HTML version with some
-particular kind of option that you don't see how to achieve using this
-module, email me (C<sburke@cpan.org>) and I'll probably have a good idea
-how to do it. For reasons of concision and energetic laziness, some
-methods and options in this module (and the dozen modules it depends on)
-are undocumented; but one of those undocumented bits might be just what
-you're looking for.
-
-
-=head1 SEE ALSO
-
-L<Pod::Simple>, L<Pod::Simple::HTMLBatch>, L<perlpod>, L<perlpodspec>
-
-
-
-
-=head1 COPYRIGHT AND DISCLAIMERS
-
-Copyright (c) 2004 Sean M. Burke. All rights reserved.
-
-This library 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.
-
-=head1 AUTHOR
-
-Sean M. Burke C<sburke@cpan.org>
-
-=cut
-
-
-
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Pod/Simple/HTMLLegacy.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Pod/Simple/HTMLLegacy.pm
deleted file mode 100644
index f78de90144f..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Pod/Simple/HTMLLegacy.pm
+++ /dev/null
@@ -1,104 +0,0 @@
-
-require 5;
-package Pod::Simple::HTMLLegacy;
-use strict;
-
-use vars qw($VERSION);
-use Getopt::Long;
-
-$VERSION = "5.01";
-
-#--------------------------------------------------------------------------
-#
-# This class is meant to thinly emulate bad old Pod::Html
-#
-# TODO: some basic docs
-
-sub pod2html {
- my @args = (@_);
-
- my( $verbose, $infile, $outfile, $title );
- my $index = 1;
-
- {
- my($help);
-
- my($netscape); # dummy
- local @ARGV = @args;
- GetOptions(
- "help" => \$help,
- "verbose!" => \$verbose,
- "infile=s" => \$infile,
- "outfile=s" => \$outfile,
- "title=s" => \$title,
- "index!" => \$index,
-
- "netscape!" => \$netscape,
- ) or return bad_opts(@args);
- bad_opts(@args) if @ARGV; # it should be all switches!
- return help_message() if $help;
- }
-
- for($infile, $outfile) { $_ = undef unless defined and length }
-
- if($verbose) {
- warn sprintf "%s version %s\n", __PACKAGE__, $VERSION;
- warn "OK, processed args [@args] ...\n";
- warn sprintf
- " Verbose: %s\n Index: %s\n Infile: %s\n Outfile: %s\n Title: %s\n",
- map defined($_) ? $_ : "(nil)",
- $verbose, $index, $infile, $outfile, $title,
- ;
- *Pod::Simple::HTML::DEBUG = sub(){1};
- }
- require Pod::Simple::HTML;
- Pod::Simple::HTML->VERSION(3);
-
- die "No such input file as $infile\n"
- if defined $infile and ! -e $infile;
-
-
- my $pod = Pod::Simple::HTML->new;
- $pod->force_title($title) if defined $title;
- $pod->index($index);
- return $pod->parse_from_file($infile, $outfile);
-}
-
-#--------------------------------------------------------------------------
-
-sub bad_opts { die _help_message(); }
-sub help_message { print STDOUT _help_message() }
-
-#--------------------------------------------------------------------------
-
-sub _help_message {
-
- join '',
-
-"[", __PACKAGE__, " version ", $VERSION, qq~]
-Usage: pod2html --help --infile=<name> --outfile=<name>
- --verbose --index --noindex
-
-Options:
- --help - prints this message.
- --[no]index - generate an index at the top of the resulting html
- (default behavior).
- --infile - filename for the pod to convert (input taken from stdin
- by default).
- --outfile - filename for the resulting html file (output sent to
- stdout by default).
- --title - title that will appear in resulting html file.
- --[no]verbose - self-explanatory (off by default).
-
-Note that pod2html is DEPRECATED, and this version implements only
- some of the options known to older versions.
-For more information, see 'perldoc pod2html'.
-~;
-
-}
-
-1;
-__END__
-
-OVER the underpass! UNDER the overpass! Around the FUTURE and BEYOND REPAIR!!
-
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Pod/Simple/LinkSection.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Pod/Simple/LinkSection.pm
deleted file mode 100644
index 14c3ba85d27..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Pod/Simple/LinkSection.pm
+++ /dev/null
@@ -1,145 +0,0 @@
-
-require 5;
-package Pod::Simple::LinkSection;
- # Based somewhat dimly on Array::Autojoin
-
-use strict;
-use Pod::Simple::BlackBox;
-
-use overload( # So it'll stringify nice
- '""' => \&Pod::Simple::BlackBox::stringify_lol,
- 'bool' => \&Pod::Simple::BlackBox::stringify_lol,
- # '.=' => \&tack_on, # grudgingly support
-
- 'fallback' => 1, # turn on cleverness
-);
-
-sub tack_on {
- $_[0] = ['', {}, "$_[0]" ];
- return $_[0][2] .= $_[1];
-}
-
-sub as_string {
- goto &Pod::Simple::BlackBox::stringify_lol;
-}
-sub stringify {
- goto &Pod::Simple::BlackBox::stringify_lol;
-}
-
-sub new {
- my $class = shift;
- $class = ref($class) || $class;
- my $new;
- if(@_ == 1) {
- if (!ref($_[0] || '')) { # most common case: one bare string
- return bless ['', {}, $_[0] ], $class;
- } elsif( ref($_[0] || '') eq 'ARRAY') {
- $new = [ @{ $_[0] } ];
- } else {
- Carp::croak( "$class new() doesn't know to clone $new" );
- }
- } else { # misc stuff
- $new = [ '', {}, @_ ];
- }
-
- # By now it's a treelet: [ 'foo', {}, ... ]
- foreach my $x (@$new) {
- if(ref($x || '') eq 'ARRAY') {
- $x = $class->new($x); # recurse
- } elsif(ref($x || '') eq 'HASH') {
- $x = { %$x };
- }
- # otherwise leave it.
- }
-
- return bless $new, $class;
-}
-
-# Not much in this class is likely to be link-section specific --
-# but it just so happens that link-sections are about the only treelets
-# that are exposed to the user.
-
-1;
-
-__END__
-
-# TODO: let it be an option whether a given subclass even wants little treelets?
-
-
-__END__
-
-=head1 NAME
-
-Pod::Simple::LinkSection -- represent "section" attributes of L codes
-
-=head1 SYNOPSIS
-
- # a long story
-
-=head1 DESCRIPTION
-
-This class is not of interest to general users.
-
-Pod::Simple uses this class for representing the value of the
-"section" attribute of "L" start-element events. Most applications
-can just use the normal stringification of objects of this class;
-they stringify to just the text content of the section,
-such as "foo" for
-C<< LZ<><Stuff/foo> >>, and "bar" for
-C<< LZ<><Stuff/bIZ<><ar>> >>.
-
-However, anyone particularly interested in getting the full value of
-the treelet, can just traverse the content of the treeleet
-@$treelet_object. To wit:
-
-
- % perl -MData::Dumper -e
- "use base qw(Pod::Simple::Methody);
- sub start_L { print Dumper($_[1]{'section'} ) }
- __PACKAGE__->new->parse_string_document('=head1 L<Foo/bI<ar>baz>>')
- "
-Output:
- $VAR1 = bless( [
- '',
- {},
- 'b',
- bless( [
- 'I',
- {},
- 'ar'
- ], 'Pod::Simple::LinkSection' ),
- 'baz'
- ], 'Pod::Simple::LinkSection' );
-
-But stringify it and you get just the text content:
-
- % perl -MData::Dumper -e
- "use base qw(Pod::Simple::Methody);
- sub start_L { print Dumper( '' . $_[1]{'section'} ) }
- __PACKAGE__->new->parse_string_document('=head1 L<Foo/bI<ar>baz>>')
- "
-Output:
- $VAR1 = 'barbaz';
-
-
-=head1 SEE ALSO
-
-L<Pod::Simple>
-
-=head1 COPYRIGHT AND DISCLAIMERS
-
-Copyright (c) 2002 Sean M. Burke. All rights reserved.
-
-This library 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.
-
-=head1 AUTHOR
-
-Sean M. Burke C<sburke@cpan.org>
-
-=cut
-
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Pod/Simple/Methody.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Pod/Simple/Methody.pm
deleted file mode 100644
index 2ad607e61b4..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Pod/Simple/Methody.pm
+++ /dev/null
@@ -1,127 +0,0 @@
-
-require 5;
-package Pod::Simple::Methody;
-use strict;
-use Pod::Simple ();
-use vars qw(@ISA $VERSION);
-$VERSION = '2.02';
-@ISA = ('Pod::Simple');
-
-# Yes, we could use named variables, but I want this to be impose
-# as little an additional performance hit as possible.
-
-sub _handle_element_start {
- $_[1] =~ tr/-:./__/;
- ( $_[0]->can( 'start_' . $_[1] )
- || return
- )->(
- $_[0], $_[2]
- );
-}
-
-sub _handle_text {
- ( $_[0]->can( 'handle_text' )
- || return
- )->(
- @_
- );
-}
-
-sub _handle_element_end {
- $_[1] =~ tr/-:./__/;
- ( $_[0]->can( 'end_' . $_[1] )
- || return
- )->(
- $_[0]
- );
-}
-
-1;
-
-
-__END__
-
-=head1 NAME
-
-Pod::Simple::Methody -- turn Pod::Simple events into method calls
-
-=head1 SYNOPSIS
-
- require 5;
- use strict;
- package SomePodFormatter;
- use base qw(Pod::Simple::Methody);
-
- sub handle_text {
- my($self, $text) = @_;
- ...
- }
-
- sub start_head1 {
- my($self, $attrs) = @_;
- ...
- }
- sub end_head1 {
- my($self) = @_;
- ...
- }
-
-...and start_/end_ methods for whatever other events you want to catch.
-
-=head1 DESCRIPTION
-
-This class is of
-interest to people writing Pod formatters based on Pod::Simple.
-
-This class (which is very small -- read the source) overrides
-Pod::Simple's _handle_element_start, _handle_text, and
-_handle_element_end methods so that parser events are turned into method
-calls. (Otherwise, this is a subclass of L<Pod::Simple> and inherits all
-its methods.)
-
-You can use this class as the base class for a Pod formatter/processor.
-
-=head1 METHOD CALLING
-
-When Pod::Simple sees a "=head1 Hi there", for example, it basically does
-this:
-
- $parser->_handle_element_start( "head1", \%attributes );
- $parser->_handle_text( "Hi there" );
- $parser->_handle_element_end( "head1" );
-
-But if you subclass Pod::Simple::Methody, it will instead do this
-when it sees a "=head1 Hi there":
-
- $parser->start_head1( \%attributes ) if $parser->can('start_head1');
- $parser->handle_text( "Hi there" ) if $parser->can('handle_text');
- $parser->end_head1() if $parser->can('end_head1');
-
-If Pod::Simple sends an event where the element name has a dash,
-period, or colon, the corresponding method name will have a underscore
-in its place. For example, "foo.bar:baz" becomes start_foo_bar_baz
-and end_foo_bar_baz.
-
-See the source for Pod::Simple::Text for an example of using this class.
-
-=head1 SEE ALSO
-
-L<Pod::Simple>, L<Pod::Simple::Subclassing>
-
-=head1 COPYRIGHT AND DISCLAIMERS
-
-Copyright (c) 2002 Sean M. Burke. All rights reserved.
-
-This library 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.
-
-=head1 AUTHOR
-
-Sean M. Burke C<sburke@cpan.org>
-
-=cut
-
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Pod/Simple/Progress.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Pod/Simple/Progress.pm
deleted file mode 100644
index bc42a952dc3..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Pod/Simple/Progress.pm
+++ /dev/null
@@ -1,93 +0,0 @@
-
-require 5;
-package Pod::Simple::Progress;
-$VERSION = "1.01";
-use strict;
-
-# Objects of this class are used for noting progress of an
-# operation every so often. Messages delivered more often than that
-# are suppressed.
-#
-# There's actually nothing in here that's specific to Pod processing;
-# but it's ad-hoc enough that I'm not willing to give it a name that
-# implies that it's generally useful, like "IO::Progress" or something.
-#
-# -- sburke
-#
-#--------------------------------------------------------------------------
-
-sub new {
- my($class,$delay) = @_;
- my $self = bless {'quiet_until' => 1}, ref($class) || $class;
- $self->to(*STDOUT{IO});
- $self->delay(defined($delay) ? $delay : 5);
- return $self;
-}
-
-sub copy {
- my $orig = shift;
- bless {%$orig, 'quiet_until' => 1}, ref($orig);
-}
-#--------------------------------------------------------------------------
-
-sub reach {
- my($self, $point, $note) = @_;
- if( (my $now = time) >= $self->{'quiet_until'}) {
- my $goal;
- my $to = $self->{'to'};
- print $to join('',
- ($self->{'quiet_until'} == 1) ? () : '... ',
- (defined $point) ? (
- '#',
- ($goal = $self->{'goal'}) ? (
- ' ' x (length($goal) - length($point)),
- $point, '/', $goal,
- ) : $point,
- $note ? ': ' : (),
- ) : (),
- $note || '',
- "\n"
- );
- $self->{'quiet_until'} = $now + $self->{'delay'};
- }
- return $self;
-}
-
-#--------------------------------------------------------------------------
-
-sub done {
- my($self, $note) = @_;
- $self->{'quiet_until'} = 1;
- return $self->reach( undef, $note );
-}
-
-#--------------------------------------------------------------------------
-# Simple accessors:
-
-sub delay {
- return $_[0]{'delay'} if @_ == 1; $_[0]{'delay'} = $_[1]; return $_[0] }
-sub goal {
- return $_[0]{'goal' } if @_ == 1; $_[0]{'goal' } = $_[1]; return $_[0] }
-sub to {
- return $_[0]{'to' } if @_ == 1; $_[0]{'to' } = $_[1]; return $_[0] }
-
-#--------------------------------------------------------------------------
-
-unless(caller) { # Simple self-test:
- my $p = __PACKAGE__->new->goal(5);
- $p->reach(1, "Primus!");
- sleep 1;
- $p->reach(2, "Secundus!");
- sleep 3;
- $p->reach(3, "Tertius!");
- sleep 5;
- $p->reach(4);
- $p->reach(5, "Quintus!");
- sleep 1;
- $p->done("All done");
-}
-
-#--------------------------------------------------------------------------
-1;
-__END__
-
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Pod/Simple/PullParser.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Pod/Simple/PullParser.pm
deleted file mode 100644
index 15d973134cf..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Pod/Simple/PullParser.pm
+++ /dev/null
@@ -1,795 +0,0 @@
-
-require 5;
-package Pod::Simple::PullParser;
-$VERSION = '2.02';
-use Pod::Simple ();
-BEGIN {@ISA = ('Pod::Simple')}
-
-use strict;
-use Carp ();
-
-use Pod::Simple::PullParserStartToken;
-use Pod::Simple::PullParserEndToken;
-use Pod::Simple::PullParserTextToken;
-
-BEGIN { *DEBUG = \&Pod::Simple::DEBUG unless defined &DEBUG }
-
-__PACKAGE__->_accessorize(
- 'source_fh', # the filehandle we're reading from
- 'source_scalar_ref', # the scalarref we're reading from
- 'source_arrayref', # the arrayref we're reading from
-);
-
-#@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
-#
-# And here is how we implement a pull-parser on top of a push-parser...
-
-sub filter {
- my($self, $source) = @_;
- $self = $self->new unless ref $self;
-
- $source = *STDIN{IO} unless defined $source;
- $self->set_source($source);
- $self->output_fh(*STDOUT{IO});
-
- $self->run; # define run() in a subclass if you want to use filter()!
- return $self;
-}
-
-# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-
-sub parse_string_document {
- my $this = shift;
- $this->set_source(\ $_[0]);
- $this->run;
-}
-
-sub parse_file {
- my($this, $filename) = @_;
- $this->set_source($filename);
- $this->run;
-}
-
-# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-# In case anyone tries to use them:
-
-sub run {
- use Carp ();
- if( __PACKAGE__ eq ref($_[0]) || $_[0]) { # I'm not being subclassed!
- Carp::croak "You can call run() only on subclasses of "
- . __PACKAGE__;
- } else {
- Carp::croak join '',
- "You can't call run() because ",
- ref($_[0]) || $_[0], " didn't define a run() method";
- }
-}
-
-sub parse_lines {
- use Carp ();
- Carp::croak "Use set_source with ", __PACKAGE__,
- " and subclasses, not parse_lines";
-}
-
-sub parse_line {
- use Carp ();
- Carp::croak "Use set_source with ", __PACKAGE__,
- " and subclasses, not parse_line";
-}
-
-#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-sub new {
- my $class = shift;
- my $self = $class->SUPER::new(@_);
- die "Couldn't construct for $class" unless $self;
-
- $self->{'token_buffer'} ||= [];
- $self->{'start_token_class'} ||= 'Pod::Simple::PullParserStartToken';
- $self->{'text_token_class'} ||= 'Pod::Simple::PullParserTextToken';
- $self->{'end_token_class'} ||= 'Pod::Simple::PullParserEndToken';
-
- DEBUG > 1 and print "New pullparser object: $self\n";
-
- return $self;
-}
-
-# ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
-
-sub get_token {
- my $self = shift;
- DEBUG > 1 and print "\nget_token starting up on $self.\n";
- DEBUG > 2 and print " Items in token-buffer (",
- scalar( @{ $self->{'token_buffer'} } ) ,
- ") :\n", map(
- " " . $_->dump . "\n", @{ $self->{'token_buffer'} }
- ),
- @{ $self->{'token_buffer'} } ? '' : ' (no tokens)',
- "\n"
- ;
-
- until( @{ $self->{'token_buffer'} } ) {
- DEBUG > 3 and print "I need to get something into my empty token buffer...\n";
- if($self->{'source_dead'}) {
- DEBUG and print "$self 's source is dead.\n";
- push @{ $self->{'token_buffer'} }, undef;
- } elsif(exists $self->{'source_fh'}) {
- my @lines;
- my $fh = $self->{'source_fh'}
- || Carp::croak('You have to call set_source before you can call get_token');
-
- DEBUG and print "$self 's source is filehandle $fh.\n";
- # Read those many lines at a time
- for(my $i = Pod::Simple::MANY_LINES; $i--;) {
- DEBUG > 3 and print " Fetching a line from source filehandle $fh...\n";
- local $/ = $Pod::Simple::NL;
- push @lines, scalar(<$fh>); # readline
- DEBUG > 3 and print " Line is: ",
- defined($lines[-1]) ? $lines[-1] : "<undef>\n";
- unless( defined $lines[-1] ) {
- DEBUG and print "That's it for that source fh! Killing.\n";
- delete $self->{'source_fh'}; # so it can be GC'd
- last;
- }
- # but pass thru the undef, which will set source_dead to true
-
- # TODO: look to see if $lines[-1] is =encoding, and if so,
- # do horribly magic things
-
- }
-
- if(DEBUG > 8) {
- print "* I've gotten ", scalar(@lines), " lines:\n";
- foreach my $l (@lines) {
- if(defined $l) {
- print " line {$l}\n";
- } else {
- print " line undef\n";
- }
- }
- print "* end of ", scalar(@lines), " lines\n";
- }
-
- $self->SUPER::parse_lines(@lines);
-
- } elsif(exists $self->{'source_arrayref'}) {
- DEBUG and print "$self 's source is arrayref $self->{'source_arrayref'}, with ",
- scalar(@{$self->{'source_arrayref'}}), " items left in it.\n";
-
- DEBUG > 3 and print " Fetching ", Pod::Simple::MANY_LINES, " lines.\n";
- $self->SUPER::parse_lines(
- splice @{ $self->{'source_arrayref'} },
- 0,
- Pod::Simple::MANY_LINES
- );
- unless( @{ $self->{'source_arrayref'} } ) {
- DEBUG and print "That's it for that source arrayref! Killing.\n";
- $self->SUPER::parse_lines(undef);
- delete $self->{'source_arrayref'}; # so it can be GC'd
- }
- # to make sure that an undef is always sent to signal end-of-stream
-
- } elsif(exists $self->{'source_scalar_ref'}) {
-
- DEBUG and print "$self 's source is scalarref $self->{'source_scalar_ref'}, with ",
- length(${ $self->{'source_scalar_ref'} }) -
- (pos(${ $self->{'source_scalar_ref'} }) || 0),
- " characters left to parse.\n";
-
- DEBUG > 3 and print " Fetching a line from source-string...\n";
- if( ${ $self->{'source_scalar_ref'} } =~
- m/([^\n\r]*)((?:\r?\n)?)/g
- ) {
- #print(">> $1\n"),
- $self->SUPER::parse_lines($1)
- if length($1) or length($2)
- or pos( ${ $self->{'source_scalar_ref'} })
- != length( ${ $self->{'source_scalar_ref'} });
- # I.e., unless it's a zero-length "empty line" at the very
- # end of "foo\nbar\n" (i.e., between the \n and the EOS).
- } else { # that's the end. Byebye
- $self->SUPER::parse_lines(undef);
- delete $self->{'source_scalar_ref'};
- DEBUG and print "That's it for that source scalarref! Killing.\n";
- }
-
-
- } else {
- die "What source??";
- }
- }
- DEBUG and print "get_token about to return ",
- Pod::Simple::pretty( @{$self->{'token_buffer'}}
- ? $self->{'token_buffer'}[-1] : undef
- ), "\n";
- return shift @{$self->{'token_buffer'}}; # that's an undef if empty
-}
-
-use UNIVERSAL ();
-sub unget_token {
- my $self = shift;
- DEBUG and print "Ungetting ", scalar(@_), " tokens: ",
- @_ ? "@_\n" : "().\n";
- foreach my $t (@_) {
- Carp::croak "Can't unget that, because it's not a token -- it's undef!"
- unless defined $t;
- Carp::croak "Can't unget $t, because it's not a token -- it's a string!"
- unless ref $t;
- Carp::croak "Can't unget $t, because it's not a token object!"
- unless UNIVERSAL::can($t, 'type');
- }
-
- unshift @{$self->{'token_buffer'}}, @_;
- DEBUG > 1 and print "Token buffer now has ",
- scalar(@{$self->{'token_buffer'}}), " items in it.\n";
- return;
-}
-
-#@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
-
-# $self->{'source_filename'} = $source;
-
-sub set_source {
- my $self = shift @_;
- return $self->{'source_fh'} unless @_;
- my $handle;
- if(!defined $_[0]) {
- Carp::croak("Can't use empty-string as a source for set_source");
- } elsif(ref(\( $_[0] )) eq 'GLOB') {
- $self->{'source_filename'} = '' . ($handle = $_[0]);
- DEBUG and print "$self 's source is glob $_[0]\n";
- # and fall thru
- } elsif(ref( $_[0] ) eq 'SCALAR') {
- $self->{'source_scalar_ref'} = $_[0];
- DEBUG and print "$self 's source is scalar ref $_[0]\n";
- return;
- } elsif(ref( $_[0] ) eq 'ARRAY') {
- $self->{'source_arrayref'} = $_[0];
- DEBUG and print "$self 's source is array ref $_[0]\n";
- return;
- } elsif(ref $_[0]) {
- $self->{'source_filename'} = '' . ($handle = $_[0]);
- DEBUG and print "$self 's source is fh-obj $_[0]\n";
- } elsif(!length $_[0]) {
- Carp::croak("Can't use empty-string as a source for set_source");
- } else { # It's a filename!
- DEBUG and print "$self 's source is filename $_[0]\n";
- {
- local *PODSOURCE;
- open(PODSOURCE, "<$_[0]") || Carp::croak "Can't open $_[0]: $!";
- $handle = *PODSOURCE{IO};
- }
- $self->{'source_filename'} = $_[0];
- DEBUG and print " Its name is $_[0].\n";
-
- # TODO: file-discipline things here!
- }
-
- $self->{'source_fh'} = $handle;
- DEBUG and print " Its handle is $handle\n";
- return 1;
-}
-
-# ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
-
-sub get_title_short { shift->get_short_title(@_) } # alias
-
-sub get_short_title {
- my $title = shift->get_title(@_);
- $title = $1 if $title =~ m/^(\S{1,60})\s+--?\s+./s;
- # turn "Foo::Bar -- bars for your foo" into "Foo::Bar"
- return $title;
-}
-
-sub get_title { shift->_get_titled_section(
- 'NAME', max_token => 50, desperate => 1, @_)
-}
-sub get_version { shift->_get_titled_section(
- 'VERSION',
- max_token => 400,
- accept_verbatim => 1,
- max_content_length => 3_000,
- @_,
- );
-}
-sub get_description { shift->_get_titled_section(
- 'DESCRIPTION',
- max_token => 400,
- max_content_length => 3_000,
- @_,
-) }
-
-sub get_authors { shift->get_author(@_) } # a harmless alias
-
-sub get_author {
- my $this = shift;
- # Max_token is so high because these are
- # typically at the end of the document:
- $this->_get_titled_section('AUTHOR' , max_token => 10_000, @_) ||
- $this->_get_titled_section('AUTHORS', max_token => 10_000, @_);
-}
-
-#--------------------------------------------------------------------------
-
-sub _get_titled_section {
- # Based on a get_title originally contributed by Graham Barr
- my($self, $titlename, %options) = (@_);
-
- my $max_token = delete $options{'max_token'};
- my $desperate_for_title = delete $options{'desperate'};
- my $accept_verbatim = delete $options{'accept_verbatim'};
- my $max_content_length = delete $options{'max_content_length'};
- $max_content_length = 120 unless defined $max_content_length;
-
- Carp::croak( "Unknown " . ((1 == keys %options) ? "option: " : "options: ")
- . join " ", map "[$_]", sort keys %options
- )
- if keys %options;
-
- my %content_containers;
- $content_containers{'Para'} = 1;
- if($accept_verbatim) {
- $content_containers{'Verbatim'} = 1;
- $content_containers{'VerbatimFormatted'} = 1;
- }
-
- my $token_count = 0;
- my $title;
- my @to_unget;
- my $state = 0;
- my $depth = 0;
-
- Carp::croak "What kind of titlename is \"$titlename\"?!" unless
- defined $titlename and $titlename =~ m/^[A-Z ]{1,60}$/s; #sanity
- my $titlename_re = quotemeta($titlename);
-
- my $head1_text_content;
- my $para_text_content;
-
- while(
- ++$token_count <= ($max_token || 1_000_000)
- and defined(my $token = $self->get_token)
- ) {
- push @to_unget, $token;
-
- if ($state == 0) { # seeking =head1
- if( $token->is_start and $token->tagname eq 'head1' ) {
- DEBUG and print " Found head1. Seeking content...\n";
- ++$state;
- $head1_text_content = '';
- }
- }
-
- elsif($state == 1) { # accumulating text until end of head1
- if( $token->is_text ) {
- DEBUG and print " Adding \"", $token->text, "\" to head1-content.\n";
- $head1_text_content .= $token->text;
- } elsif( $token->is_end and $token->tagname eq 'head1' ) {
- DEBUG and print " Found end of head1. Considering content...\n";
- if($head1_text_content eq $titlename
- or $head1_text_content =~ m/\($titlename_re\)/s
- # We accept "=head1 Nomen Modularis (NAME)" for sake of i18n
- ) {
- DEBUG and print " Yup, it was $titlename. Seeking next para-content...\n";
- ++$state;
- } elsif(
- $desperate_for_title
- # if we're so desperate we'll take the first
- # =head1's content as a title
- and $head1_text_content =~ m/\S/
- and $head1_text_content !~ m/^[ A-Z]+$/s
- and $head1_text_content !~
- m/\((?:
- NAME | TITLE | VERSION | AUTHORS? | DESCRIPTION | SYNOPSIS
- | COPYRIGHT | LICENSE | NOTES? | FUNCTIONS? | METHODS?
- | CAVEATS? | BUGS? | SEE\ ALSO | SWITCHES | ENVIRONMENT
- )\)/sx
- # avoid accepting things like =head1 Thingy Thongy (DESCRIPTION)
- and ($max_content_length
- ? (length($head1_text_content) <= $max_content_length) # sanity
- : 1)
- ) {
- DEBUG and print " It looks titular: \"$head1_text_content\".\n",
- "\n Using that.\n";
- $title = $head1_text_content;
- last;
- } else {
- --$state;
- DEBUG and print " Didn't look titular ($head1_text_content).\n",
- "\n Dropping back to seeking-head1-content mode...\n";
- }
- }
- }
-
- elsif($state == 2) {
- # seeking start of para (which must immediately follow)
- if($token->is_start and $content_containers{ $token->tagname }) {
- DEBUG and print " Found start of Para. Accumulating content...\n";
- $para_text_content = '';
- ++$state;
- } else {
- DEBUG and print
- " Didn't see an immediately subsequent start-Para. Reseeking H1\n";
- $state = 0;
- }
- }
-
- elsif($state == 3) {
- # accumulating text until end of Para
- if( $token->is_text ) {
- DEBUG and print " Adding \"", $token->text, "\" to para-content.\n";
- $para_text_content .= $token->text;
- # and keep looking
-
- } elsif( $token->is_end and $content_containers{ $token->tagname } ) {
- DEBUG and print " Found end of Para. Considering content: ",
- $para_text_content, "\n";
-
- if( $para_text_content =~ m/\S/
- and ($max_content_length
- ? (length($para_text_content) <= $max_content_length)
- : 1)
- ) {
- # Some minimal sanity constraints, I think.
- DEBUG and print " It looks contentworthy, I guess. Using it.\n";
- $title = $para_text_content;
- last;
- } else {
- DEBUG and print " Doesn't look at all contentworthy!\n Giving up.\n";
- undef $title;
- last;
- }
- }
- }
-
- else {
- die "IMPOSSIBLE STATE $state!\n"; # should never happen
- }
-
- }
-
- # Put it all back!
- $self->unget_token(@to_unget);
-
- if(DEBUG) {
- if(defined $title) { print " Returing title <$title>\n" }
- else { print "Returning title <>\n" }
- }
-
- return '' unless defined $title;
- $title =~ s/^\s+//;
- return $title;
-}
-
-#@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
-#
-# Methods that actually do work at parse-time:
-
-sub _handle_element_start {
- my $self = shift; # leaving ($element_name, $attr_hash_r)
- DEBUG > 2 and print "++ $_[0] (", map("<$_> ", %{$_[1]}), ")\n";
-
- push @{ $self->{'token_buffer'} },
- $self->{'start_token_class'}->new(@_);
- return;
-}
-
-sub _handle_text {
- my $self = shift; # leaving ($text)
- DEBUG > 2 and print "== $_[0]\n";
- push @{ $self->{'token_buffer'} },
- $self->{'text_token_class'}->new(@_);
- return;
-}
-
-sub _handle_element_end {
- my $self = shift; # leaving ($element_name);
- DEBUG > 2 and print "-- $_[0]\n";
- push @{ $self->{'token_buffer'} },
- $self->{'end_token_class'}->new(@_);
- return;
-}
-
-#@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
-
-1;
-
-
-__END__
-
-=head1 NAME
-
-Pod::Simple::PullParser -- a pull-parser interface to parsing Pod
-
-=head1 SYNOPSIS
-
- my $parser = SomePodProcessor->new;
- $parser->set_source( "whatever.pod" );
- $parser->run;
-
-Or:
-
- my $parser = SomePodProcessor->new;
- $parser->set_source( $some_filehandle_object );
- $parser->run;
-
-Or:
-
- my $parser = SomePodProcessor->new;
- $parser->set_source( \$document_source );
- $parser->run;
-
-Or:
-
- my $parser = SomePodProcessor->new;
- $parser->set_source( \@document_lines );
- $parser->run;
-
-And elsewhere:
-
- require 5;
- package SomePodProcessor;
- use strict;
- use base qw(Pod::Simple::PullParser);
-
- sub run {
- my $self = shift;
- Token:
- while(my $token = $self->get_token) {
- ...process each token...
- }
- }
-
-=head1 DESCRIPTION
-
-This class is for using Pod::Simple to build a Pod processor -- but
-one that uses an interface based on a stream of token objects,
-instead of based on events.
-
-This is a subclass of L<Pod::Simple> and inherits all its methods.
-
-A subclass of Pod::Simple::PullParser should define a C<run> method
-that calls C<< $token = $parser->get_token >> to pull tokens.
-
-See the source for Pod::Simple::RTF for an example of a formatter
-that uses Pod::Simple::PullParser.
-
-=head1 METHODS
-
-=over
-
-=item my $token = $parser->get_token
-
-This returns the next token object (which will be of a subclass of
-L<Pod::Simple::PullParserToken>), or undef if the parser-stream has hit
-the end of the document.
-
-=item $parser->unget_token( $token )
-
-=item $parser->unget_token( $token1, $token2, ... )
-
-This restores the token object(s) to the front of the parser stream.
-
-=back
-
-The source has to be set before you can parse anything. The lowest-level
-way is to call C<set_source>:
-
-=over
-
-=item $parser->set_source( $filename )
-
-=item $parser->set_source( $filehandle_object )
-
-=item $parser->set_source( \$document_source )
-
-=item $parser->set_source( \@document_lines )
-
-=back
-
-Or you can call these methods, which Pod::Simple::PullParser has defined
-to work just like Pod::Simple's same-named methods:
-
-=over
-
-=item $parser->parse_file(...)
-
-=item $parser->parse_string_document(...)
-
-=item $parser->filter(...)
-
-=item $parser->parse_from_file(...)
-
-=back
-
-For those to work, the Pod-processing subclass of
-Pod::Simple::PullParser has to have defined a $parser->run method --
-so it is advised that all Pod::Simple::PullParser subclasses do so.
-See the Synopsis above, or the source for Pod::Simple::RTF.
-
-Authors of formatter subclasses might find these methods useful to
-call on a parser object that you haven't started pulling tokens
-from yet:
-
-=over
-
-=item my $title_string = $parser->get_title
-
-This tries to get the title string out of $parser, by getting some tokens,
-and scanning them for the title, and then ungetting them so that you can
-process the token-stream from the beginning.
-
-For example, suppose you have a document that starts out:
-
- =head1 NAME
-
- Hoo::Boy::Wowza -- Stuff B<wow> yeah!
-
-$parser->get_title on that document will return "Hoo::Boy::Wowza --
-Stuff wow yeah!".
-
-In cases where get_title can't find the title, it will return empty-string
-("").
-
-=item my $title_string = $parser->get_short_title
-
-This is just like get_title, except that it returns just the modulename, if
-the title seems to be of the form "SomeModuleName -- description".
-
-For example, suppose you have a document that starts out:
-
- =head1 NAME
-
- Hoo::Boy::Wowza -- Stuff B<wow> yeah!
-
-then $parser->get_short_title on that document will return
-"Hoo::Boy::Wowza".
-
-But if the document starts out:
-
- =head1 NAME
-
- Hooboy, stuff B<wow> yeah!
-
-then $parser->get_short_title on that document will return "Hooboy,
-stuff wow yeah!".
-
-If the title can't be found, then get_short_title returns empty-string
-("").
-
-=item $author_name = $parser->get_author
-
-This works like get_title except that it returns the contents of the
-"=head1 AUTHOR\n\nParagraph...\n" section, assuming that that section
-isn't terribly long.
-
-(This method tolerates "AUTHORS" instead of "AUTHOR" too.)
-
-=item $description_name = $parser->get_description
-
-This works like get_title except that it returns the contents of the
-"=head1 PARAGRAPH\n\nParagraph...\n" section, assuming that that section
-isn't terribly long.
-
-=item $version_block = $parser->get_version
-
-This works like get_title except that it returns the contents of
-the "=head1 VERSION\n\n[BIG BLOCK]\n" block. Note that this does NOT
-return the module's C<$VERSION>!!
-
-
-=back
-
-=head1 NOTE
-
-You don't actually I<have> to define a C<run> method. If you're
-writing a Pod-formatter class, you should define a C<run> just so
-that users can call C<parse_file> etc, but you don't I<have> to.
-
-And if you're not writing a formatter class, but are instead just
-writing a program that does something simple with a Pod::PullParser
-object (and not an object of a subclass), then there's no reason to
-bother subclassing to add a C<run> method.
-
-=head1 SEE ALSO
-
-L<Pod::Simple>
-
-L<Pod::Simple::PullParserToken> -- and its subclasses
-L<Pod::Simple::PullParserStartToken>,
-L<Pod::Simple::PullParserTextToken>, and
-L<Pod::Simple::PullParserEndToken>.
-
-L<HTML::TokeParser>, which inspired this.
-
-=head1 COPYRIGHT AND DISCLAIMERS
-
-Copyright (c) 2002 Sean M. Burke. All rights reserved.
-
-This library 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.
-
-=head1 AUTHOR
-
-Sean M. Burke C<sburke@cpan.org>
-
-=cut
-
-
-
-JUNK:
-
-sub _old_get_title { # some witchery in here
- my $self = $_[0];
- my $title;
- my @to_unget;
-
- while(1) {
- push @to_unget, $self->get_token;
- unless(defined $to_unget[-1]) { # whoops, short doc!
- pop @to_unget;
- last;
- }
-
- DEBUG and print "-Got token ", $to_unget[-1]->dump, "\n";
-
- (DEBUG and print "Too much in the buffer.\n"),
- last if @to_unget > 25; # sanity
-
- my $pattern = '';
- if( #$to_unget[-1]->type eq 'end'
- #and $to_unget[-1]->tagname eq 'Para'
- #and
- ($pattern = join('',
- map {;
- ($_->type eq 'start') ? ("<" . $_->tagname .">")
- : ($_->type eq 'end' ) ? ("</". $_->tagname .">")
- : ($_->type eq 'text' ) ? ($_->text =~ m<^([A-Z]+)$>s ? $1 : 'X')
- : "BLORP"
- } @to_unget
- )) =~ m{<head1>NAME</head1><Para>(X|</?[BCIFLS]>)+</Para>$}s
- ) {
- # Whee, it fits the pattern
- DEBUG and print "Seems to match =head1 NAME pattern.\n";
- $title = '';
- foreach my $t (reverse @to_unget) {
- last if $t->type eq 'start' and $t->tagname eq 'Para';
- $title = $t->text . $title if $t->type eq 'text';
- }
- undef $title if $title =~ m<^\s*$>; # make sure it's contentful!
- last;
-
- } elsif ($pattern =~ m{<head(\d)>(.+)</head\d>$}
- and !( $1 eq '1' and $2 eq 'NAME' )
- ) {
- # Well, it fits a fallback pattern
- DEBUG and print "Seems to match NAMEless pattern.\n";
- $title = '';
- foreach my $t (reverse @to_unget) {
- last if $t->type eq 'start' and $t->tagname =~ m/^head\d$/s;
- $title = $t->text . $title if $t->type eq 'text';
- }
- undef $title if $title =~ m<^\s*$>; # make sure it's contentful!
- last;
-
- } else {
- DEBUG and $pattern and print "Leading pattern: $pattern\n";
- }
- }
-
- # Put it all back:
- $self->unget_token(@to_unget);
-
- if(DEBUG) {
- if(defined $title) { print " Returing title <$title>\n" }
- else { print "Returning title <>\n" }
- }
-
- return '' unless defined $title;
- return $title;
-}
-
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Pod/Simple/PullParserEndToken.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Pod/Simple/PullParserEndToken.pm
deleted file mode 100644
index 7b219f8660d..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Pod/Simple/PullParserEndToken.pm
+++ /dev/null
@@ -1,93 +0,0 @@
-
-require 5;
-package Pod::Simple::PullParserEndToken;
-use Pod::Simple::PullParserToken ();
-@ISA = ('Pod::Simple::PullParserToken');
-use strict;
-
-sub new { # Class->new(tagname);
- my $class = shift;
- return bless ['end', @_], ref($class) || $class;
-}
-
-# Purely accessors:
-
-sub tagname { (@_ == 2) ? ($_[0][1] = $_[1]) : $_[0][1] }
-sub tag { shift->tagname(@_) }
-
-# shortcut:
-sub is_tagname { $_[0][1] eq $_[1] }
-sub is_tag { shift->is_tagname(@_) }
-
-1;
-
-
-__END__
-
-=head1 NAME
-
-Pod::Simple::PullParserEndToken -- end-tokens from Pod::Simple::PullParser
-
-=head1 SYNOPSIS
-
-(See L<Pod::Simple::PullParser>)
-
-=head1 DESCRIPTION
-
-When you do $parser->get_token on a L<Pod::Simple::PullParser>, you might
-get an object of this class.
-
-This is a subclass of L<Pod::Simple::PullParserToken> and inherits all its methods,
-and adds these methods:
-
-=over
-
-=item $token->tagname
-
-This returns the tagname for this end-token object.
-For example, parsing a "=head1 ..." line will give you
-a start-token with the tagname of "head1", token(s) for its
-content, and then an end-token with the tagname of "head1".
-
-=item $token->tagname(I<somestring>)
-
-This changes the tagname for this end-token object.
-You probably won't need to do this.
-
-=item $token->tag(...)
-
-A shortcut for $token->tagname(...)
-
-=item $token->is_tag(I<somestring>) or $token->is_tagname(I<somestring>)
-
-These are shortcuts for C<< $token->tag() eq I<somestring> >>
-
-=back
-
-You're unlikely to ever need to construct an object of this class for
-yourself, but if you want to, call
-C<<
-Pod::Simple::PullParserEndToken->new( I<tagname> )
->>
-
-=head1 SEE ALSO
-
-L<Pod::Simple::PullParserToken>, L<Pod::Simple>, L<Pod::Simple::Subclassing>
-
-=head1 COPYRIGHT AND DISCLAIMERS
-
-Copyright (c) 2002 Sean M. Burke. All rights reserved.
-
-This library 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.
-
-=head1 AUTHOR
-
-Sean M. Burke C<sburke@cpan.org>
-
-=cut
-
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Pod/Simple/PullParserStartToken.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Pod/Simple/PullParserStartToken.pm
deleted file mode 100644
index 9ead50d96ef..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Pod/Simple/PullParserStartToken.pm
+++ /dev/null
@@ -1,130 +0,0 @@
-
-require 5;
-package Pod::Simple::PullParserStartToken;
-use Pod::Simple::PullParserToken ();
-@ISA = ('Pod::Simple::PullParserToken');
-use strict;
-
-sub new { # Class->new(tagname, optional_attrhash);
- my $class = shift;
- return bless ['start', @_], ref($class) || $class;
-}
-
-# Purely accessors:
-
-sub tagname { (@_ == 2) ? ($_[0][1] = $_[1]) : $_[0][1] }
-sub tag { shift->tagname(@_) }
-
-sub is_tagname { $_[0][1] eq $_[1] }
-sub is_tag { shift->is_tagname(@_) }
-
-
-sub attr_hash { $_[0][2] ||= {} }
-
-sub attr {
- if(@_ == 2) { # Reading: $token->attr('attrname')
- ${$_[0][2] || return undef}{ $_[1] };
- } elsif(@_ > 2) { # Writing: $token->attr('attrname', 'newval')
- ${$_[0][2] ||= {}}{ $_[1] } = $_[2];
- } else {
- require Carp;
- Carp::croak(
- 'usage: $object->attr("val") or $object->attr("key", "newval")');
- return undef;
- }
-}
-
-1;
-
-
-__END__
-
-=head1 NAME
-
-Pod::Simple::PullParserStartToken -- start-tokens from Pod::Simple::PullParser
-
-=head1 SYNOPSIS
-
-(See L<Pod::Simple::PullParser>)
-
-=head1 DESCRIPTION
-
-When you do $parser->get_token on a L<Pod::Simple::PullParser> object, you might
-get an object of this class.
-
-This is a subclass of L<Pod::Simple::PullParserToken> and inherits all its methods,
-and adds these methods:
-
-=over
-
-=item $token->tagname
-
-This returns the tagname for this start-token object.
-For example, parsing a "=head1 ..." line will give you
-a start-token with the tagname of "head1", token(s) for its
-content, and then an end-token with the tagname of "head1".
-
-=item $token->tagname(I<somestring>)
-
-This changes the tagname for this start-token object.
-You probably won't need
-to do this.
-
-=item $token->tag(...)
-
-A shortcut for $token->tagname(...)
-
-=item $token->is_tag(I<somestring>) or $token->is_tagname(I<somestring>)
-
-These are shortcuts for C<< $token->tag() eq I<somestring> >>
-
-=item $token->attr(I<attrname>)
-
-This returns the value of the I<attrname> attribute for this start-token
-object, or undef.
-
-For example, parsing a LZ<><Foo/"Bar"> link will produce a start-token
-with a "to" attribute with the value "Foo", a "type" attribute with the
-value "pod", and a "section" attribute with the value "Bar".
-
-=item $token->attr(I<attrname>, I<newvalue>)
-
-This sets the I<attrname> attribute for this start-token object to
-I<newvalue>. You probably won't need to do this.
-
-=item $token->attr_hash
-
-This returns the hashref that is the attribute set for this start-token.
-This is useful if (for example) you want to ask what all the attributes
-are -- you can just do C<< keys %{$token->attr_hash} >>
-
-=back
-
-
-You're unlikely to ever need to construct an object of this class for
-yourself, but if you want to, call
-C<<
-Pod::Simple::PullParserStartToken->new( I<tagname>, I<attrhash> )
->>
-
-=head1 SEE ALSO
-
-L<Pod::Simple::PullParserToken>, L<Pod::Simple>, L<Pod::Simple::Subclassing>
-
-=head1 COPYRIGHT AND DISCLAIMERS
-
-Copyright (c) 2002 Sean M. Burke. All rights reserved.
-
-This library 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.
-
-=head1 AUTHOR
-
-Sean M. Burke C<sburke@cpan.org>
-
-=cut
-
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Pod/Simple/PullParserTextToken.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Pod/Simple/PullParserTextToken.pm
deleted file mode 100644
index 2d1a1d7dc45..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Pod/Simple/PullParserTextToken.pm
+++ /dev/null
@@ -1,101 +0,0 @@
-
-require 5;
-package Pod::Simple::PullParserTextToken;
-use Pod::Simple::PullParserToken ();
-@ISA = ('Pod::Simple::PullParserToken');
-use strict;
-
-sub new { # Class->new(text);
- my $class = shift;
- return bless ['text', @_], ref($class) || $class;
-}
-
-# Purely accessors:
-
-sub text { (@_ == 2) ? ($_[0][1] = $_[1]) : $_[0][1] }
-
-sub text_r { \ $_[0][1] }
-
-1;
-
-__END__
-
-=head1 NAME
-
-Pod::Simple::PullParserTextToken -- text-tokens from Pod::Simple::PullParser
-
-=head1 SYNOPSIS
-
-(See L<Pod::Simple::PullParser>)
-
-=head1 DESCRIPTION
-
-When you do $parser->get_token on a L<Pod::Simple::PullParser>, you might
-get an object of this class.
-
-This is a subclass of L<Pod::Simple::PullParserToken> and inherits all its methods,
-and adds these methods:
-
-=over
-
-=item $token->text
-
-This returns the text that this token holds. For example, parsing
-CZ<><foo> will return a C start-token, a text-token, and a C end-token. And
-if you want to get the "foo" out of the text-token, call C<< $token->text >>
-
-=item $token->text(I<somestring>)
-
-This changes the string that this token holds. You probably won't need
-to do this.
-
-=item $token->text_r()
-
-This returns a scalar reference to the string that this token holds.
-This can be useful if you don't want to memory-copy the potentially
-large text value (well, as large as a paragraph or a verbatim block)
-as calling $token->text would do.
-
-Or, if you want to alter the value, you can even do things like this:
-
- for ( ${ $token->text_r } ) { # Aliases it with $_ !!
-
- s/ The / the /g; # just for example
-
- if( 'A' eq chr(65) ) { # (if in an ASCII world)
- tr/\xA0/ /;
- tr/\xAD//d;
- }
-
- ...or however you want to alter the value...
- }
-
-=back
-
-You're unlikely to ever need to construct an object of this class for
-yourself, but if you want to, call
-C<<
-Pod::Simple::PullParserTextToken->new( I<text> )
->>
-
-=head1 SEE ALSO
-
-L<Pod::Simple::PullParserToken>, L<Pod::Simple>, L<Pod::Simple::Subclassing>
-
-=head1 COPYRIGHT AND DISCLAIMERS
-
-Copyright (c) 2002 Sean M. Burke. All rights reserved.
-
-This library 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.
-
-=head1 AUTHOR
-
-Sean M. Burke C<sburke@cpan.org>
-
-=cut
-
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Pod/Simple/PullParserToken.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Pod/Simple/PullParserToken.pm
deleted file mode 100644
index 9ec3659f4ed..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Pod/Simple/PullParserToken.pm
+++ /dev/null
@@ -1,138 +0,0 @@
-
-require 5;
-package Pod::Simple::PullParserToken;
- # Base class for tokens gotten from Pod::Simple::PullParser's $parser->get_token
-@ISA = ();
-$VERSION = '2.02';
-use strict;
-
-sub new { # Class->new('type', stuff...); ## Overridden in derived classes anyway
- my $class = shift;
- return bless [@_], ref($class) || $class;
-}
-
-sub type { $_[0][0] } # Can't change the type of an object
-sub dump { Pod::Simple::pretty( [ @{ $_[0] } ] ) }
-
-sub is_start { $_[0][0] eq 'start' }
-sub is_end { $_[0][0] eq 'end' }
-sub is_text { $_[0][0] eq 'text' }
-
-1;
-__END__
-
-sub dump { '[' . _esc( @{ $_[0] } ) . ']' }
-
-# JUNK:
-
-sub _esc {
- return '' unless @_;
- my @out;
- foreach my $in (@_) {
- push @out, '"' . $in . '"';
- $out[-1] =~ s/([^- \:\:\.\,\'\>\<\"\/\=\?\+\|\[\]\{\}\_a-zA-Z0-9_\`\~\!\#\%\^\&\*\(\)])/
- sprintf( (ord($1) < 256) ? "\\x%02X" : "\\x{%X}", ord($1))
- /eg;
- }
- return join ', ', @out;
-}
-
-
-__END__
-
-=head1 NAME
-
-Pod::Simple::PullParserToken -- tokens from Pod::Simple::PullParser
-
-=head1 SYNOPSIS
-
-Given a $parser that's an object of class Pod::Simple::PullParser
-(or a subclass)...
-
- while(my $token = $parser->get_token) {
- $DEBUG and print "Token: ", $token->dump, "\n";
- if($token->is_start) {
- ...access $token->tagname, $token->attr, etc...
-
- } elsif($token->is_text) {
- ...access $token->text, $token->text_r, etc...
-
- } elsif($token->is_end) {
- ...access $token->tagname...
-
- }
- }
-
-(Also see L<Pod::Simple::PullParser>)
-
-=head1 DESCRIPTION
-
-When you do $parser->get_token on a L<Pod::Simple::PullParser>, you should
-get an object of a subclass of Pod::Simple::PullParserToken.
-
-Subclasses will add methods, and will also inherit these methods:
-
-=over
-
-=item $token->type
-
-This returns the type of the token. This will be either the string
-"start", the string "text", or the string "end".
-
-Once you know what the type of an object is, you then know what
-subclass it belongs to, and therefore what methods it supports.
-
-Yes, you could probably do the same thing with code like
-$token->isa('Pod::Simple::PullParserEndToken'), but that's not so
-pretty as using just $token->type, or even the following shortcuts:
-
-=item $token->is_start
-
-This is a shortcut for C<< $token->type() eq "start" >>
-
-=item $token->is_text
-
-This is a shortcut for C<< $token->type() eq "text" >>
-
-=item $token->is_end
-
-This is a shortcut for C<< $token->type() eq "end" >>
-
-=item $token->dump
-
-This returns a handy stringified value of this object. This
-is useful for debugging, as in:
-
- while(my $token = $parser->get_token) {
- $DEBUG and print "Token: ", $token->dump, "\n";
- ...
- }
-
-=back
-
-=head1 SEE ALSO
-
-My subclasses:
-L<Pod::Simple::PullParserStartToken>,
-L<Pod::Simple::PullParserTextToken>, and
-L<Pod::Simple::PullParserEndToken>.
-
-L<Pod::Simple::PullParser> and L<Pod::Simple>
-
-=head1 COPYRIGHT AND DISCLAIMERS
-
-Copyright (c) 2002 Sean M. Burke. All rights reserved.
-
-This library 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.
-
-=head1 AUTHOR
-
-Sean M. Burke C<sburke@cpan.org>
-
-=cut
-
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Pod/Simple/RTF.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Pod/Simple/RTF.pm
deleted file mode 100644
index de2a7b32d64..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Pod/Simple/RTF.pm
+++ /dev/null
@@ -1,674 +0,0 @@
-
-require 5;
-package Pod::Simple::RTF;
-
-#sub DEBUG () {4};
-#sub Pod::Simple::DEBUG () {4};
-#sub Pod::Simple::PullParser::DEBUG () {4};
-
-use strict;
-use vars qw($VERSION @ISA %Escape $WRAP %Tagmap);
-$VERSION = '2.02';
-use Pod::Simple::PullParser ();
-BEGIN {@ISA = ('Pod::Simple::PullParser')}
-
-use Carp ();
-BEGIN { *DEBUG = \&Pod::Simple::DEBUG unless defined &DEBUG }
-
-$WRAP = 1 unless defined $WRAP;
-
-#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-sub _openclose {
- return map {;
- m/^([-A-Za-z]+)=(\w[^\=]*)$/s or die "what's <$_>?";
- ( $1, "{\\$2\n", "/$1", "}" );
- } @_;
-}
-
-my @_to_accept;
-
-%Tagmap = (
- # 'foo=bar' means ('foo' => '{\bar'."\n", '/foo' => '}')
- _openclose(
- 'B=cs18\b',
- 'I=cs16\i',
- 'C=cs19\f1\lang1024\noproof',
- 'F=cs17\i\lang1024\noproof',
-
- 'VerbatimI=cs26\i',
- 'VerbatimB=cs27\b',
- 'VerbatimBI=cs28\b\i',
-
- map {; m/^([-a-z]+)/s && push @_to_accept, $1; $_ }
- qw[
- underline=ul smallcaps=scaps shadow=shad
- superscript=super subscript=sub strikethrough=strike
- outline=outl emboss=embo engrave=impr
- dotted-underline=uld dash-underline=uldash
- dot-dash-underline=uldashd dot-dot-dash-underline=uldashdd
- double-underline=uldb thick-underline=ulth
- word-underline=ulw wave-underline=ulwave
- ]
- # But no double-strikethrough, because MSWord can't agree with the
- # RTF spec on whether it's supposed to be \strikedl or \striked1 (!!!)
- ),
-
- # Bit of a hack here:
- 'L=pod' => '{\cs22\i'."\n",
- 'L=url' => '{\cs23\i'."\n",
- 'L=man' => '{\cs24\i'."\n",
- '/L' => '}',
-
- 'Data' => "\n",
- '/Data' => "\n",
-
- 'Verbatim' => "\n{\\pard\\li#rtfindent##rtfkeep#\\plain\\s20\\sa180\\f1\\fs18\\lang1024\\noproof\n",
- '/Verbatim' => "\n\\par}\n",
- 'VerbatimFormatted' => "\n{\\pard\\li#rtfindent##rtfkeep#\\plain\\s20\\sa180\\f1\\fs18\\lang1024\\noproof\n",
- '/VerbatimFormatted' => "\n\\par}\n",
- 'Para' => "\n{\\pard\\li#rtfindent#\\sa180\n",
- '/Para' => "\n\\par}\n",
- 'head1' => "\n{\\pard\\li#rtfindent#\\s31\\keepn\\sb90\\sa180\\f2\\fs#head1_halfpoint_size#\\ul{\n",
- '/head1' => "\n}\\par}\n",
- 'head2' => "\n{\\pard\\li#rtfindent#\\s32\\keepn\\sb90\\sa180\\f2\\fs#head2_halfpoint_size#\\ul{\n",
- '/head2' => "\n}\\par}\n",
- 'head3' => "\n{\\pard\\li#rtfindent#\\s33\\keepn\\sb90\\sa180\\f2\\fs#head3_halfpoint_size#\\ul{\n",
- '/head3' => "\n}\\par}\n",
- 'head4' => "\n{\\pard\\li#rtfindent#\\s34\\keepn\\sb90\\sa180\\f2\\fs#head4_halfpoint_size#\\ul{\n",
- '/head4' => "\n}\\par}\n",
- # wordpad borks on \tc\tcl1, or I'd put that in =head1 and =head2
-
- 'item-bullet' => "\n{\\pard\\li#rtfindent##rtfitemkeepn#\\sb60\\sa150\\fi-120\n",
- '/item-bullet' => "\n\\par}\n",
- 'item-number' => "\n{\\pard\\li#rtfindent##rtfitemkeepn#\\sb60\\sa150\\fi-120\n",
- '/item-number' => "\n\\par}\n",
- 'item-text' => "\n{\\pard\\li#rtfindent##rtfitemkeepn#\\sb60\\sa150\\fi-120\n",
- '/item-text' => "\n\\par}\n",
-
- # we don't need any styles for over-* and /over-*
-);
-
-
-#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-sub new {
- my $new = shift->SUPER::new(@_);
- $new->nix_X_codes(1);
- $new->nbsp_for_S(1);
- $new->accept_targets( 'rtf', 'RTF' );
-
- $new->{'Tagmap'} = {%Tagmap};
-
- $new->accept_codes(@_to_accept);
- $new->accept_codes('VerbatimFormatted');
- DEBUG > 2 and print "To accept: ", join(' ',@_to_accept), "\n";
- $new->doc_lang(
- ( $ENV{'RTFDEFLANG'} || '') =~ m/^(\d{1,10})$/s ? $1
- : ($ENV{'RTFDEFLANG'} || '') =~ m/^0?x([a-fA-F0-9]{1,10})$/s ? hex($1)
- # yes, tolerate hex!
- : ($ENV{'RTFDEFLANG'} || '') =~ m/^([a-fA-F0-9]{4})$/s ? hex($1)
- # yes, tolerate even more hex!
- : '1033'
- );
-
- $new->head1_halfpoint_size(32);
- $new->head2_halfpoint_size(28);
- $new->head3_halfpoint_size(25);
- $new->head4_halfpoint_size(22);
- $new->codeblock_halfpoint_size(18);
- $new->header_halfpoint_size(17);
- $new->normal_halfpoint_size(25);
-
- return $new;
-}
-
-#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-__PACKAGE__->_accessorize(
- 'doc_lang',
- 'head1_halfpoint_size',
- 'head2_halfpoint_size',
- 'head3_halfpoint_size',
- 'head4_halfpoint_size',
- 'codeblock_halfpoint_size',
- 'header_halfpoint_size',
- 'normal_halfpoint_size',
- 'no_proofing_exemptions',
-);
-
-
-#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-sub run {
- my $self = $_[0];
- return $self->do_middle if $self->bare_output;
- return
- $self->do_beginning && $self->do_middle && $self->do_end;
-}
-
-
-#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-sub do_middle { # the main work
- my $self = $_[0];
- my $fh = $self->{'output_fh'};
-
- my($token, $type, $tagname, $scratch);
- my @stack;
- my @indent_stack;
- $self->{'rtfindent'} = 0 unless defined $self->{'rtfindent'};
-
- while($token = $self->get_token) {
-
- if( ($type = $token->type) eq 'text' ) {
- if( $self->{'rtfverbatim'} ) {
- DEBUG > 1 and print " $type " , $token->text, " in verbatim!\n";
- rtf_esc_codely($scratch = $token->text);
- print $fh $scratch;
- next;
- }
-
- DEBUG > 1 and print " $type " , $token->text, "\n";
-
- $scratch = $token->text;
- $scratch =~ tr/\t\cb\cc/ /d;
-
- $self->{'no_proofing_exemptions'} or $scratch =~
- s/(?:
- ^
- |
- (?<=[\cm\cj\t "\[\<\(])
- ) # start on whitespace, sequence-start, or quote
- ( # something looking like a Perl token:
- (?:
- [\$\@\:\<\*\\_]\S+ # either starting with a sigil, etc.
- )
- |
- # or starting alpha, but containing anything strange:
- (?:
- [a-zA-Z'\x80-\xFF]+[\$\@\:_<>\(\\\*]\S+
- )
- )
- /\cb$1\cc/xsg
- ;
-
- rtf_esc($scratch);
- $scratch =~
- s/(
- [^\cm\cj\n]{65} # Snare 65 characters from a line
- [^\cm\cj\n\x20]{0,50} # and finish any current word
- )
- (\x20{1,10})(?![\cm\cj\n]) # capture some spaces not at line-end
- /$1$2\n/gx # and put a NL before those spaces
- if $WRAP;
- # This may wrap at well past the 65th column, but not past the 120th.
-
- print $fh $scratch;
-
- } elsif( $type eq 'start' ) {
- DEBUG > 1 and print " +$type ",$token->tagname,
- " (", map("<$_> ", %{$token->attr_hash}), ")\n";
-
- if( ($tagname = $token->tagname) eq 'Verbatim'
- or $tagname eq 'VerbatimFormatted'
- ) {
- ++$self->{'rtfverbatim'};
- my $next = $self->get_token;
- next unless defined $next;
- my $line_count = 1;
- if($next->type eq 'text') {
- my $t = $next->text_r;
- while( $$t =~ m/$/mg ) {
- last if ++$line_count > 15; # no point in counting further
- }
- DEBUG > 3 and print " verbatim line count: $line_count\n";
- }
- $self->unget_token($next);
- $self->{'rtfkeep'} = ($line_count > 15) ? '' : '\keepn' ;
-
- } elsif( $tagname =~ m/^item-/s ) {
- my @to_unget;
- my $text_count_here = 0;
- $self->{'rtfitemkeepn'} = '';
- # Some heuristics to stop item-*'s functioning as subheadings
- # from getting split from the things they're subheadings for.
- #
- # It's not terribly pretty, but it really does make things pretty.
- #
- while(1) {
- push @to_unget, $self->get_token;
- pop(@to_unget), last unless defined $to_unget[-1];
- # Erroneously used to be "unshift" instead of pop! Adds instead
- # of removes, and operates on the beginning instead of the end!
-
- if($to_unget[-1]->type eq 'text') {
- if( ($text_count_here += length ${$to_unget[-1]->text_r}) > 150 ){
- DEBUG > 1 and print " item-* is too long to be keepn'd.\n";
- last;
- }
- } elsif (@to_unget > 1 and
- $to_unget[-2]->type eq 'end' and
- $to_unget[-2]->tagname =~ m/^item-/s
- ) {
- # Bail out here, after setting rtfitemkeepn yea or nay.
- $self->{'rtfitemkeepn'} = '\keepn' if
- $to_unget[-1]->type eq 'start' and
- $to_unget[-1]->tagname eq 'Para';
-
- DEBUG > 1 and printf " item-* before %s(%s) %s keepn'd.\n",
- $to_unget[-1]->type,
- $to_unget[-1]->can('tagname') ? $to_unget[-1]->tagname : '',
- $self->{'rtfitemkeepn'} ? "gets" : "doesn't get";
- last;
- } elsif (@to_unget > 40) {
- DEBUG > 1 and print " item-* now has too many tokens (",
- scalar(@to_unget),
- (DEBUG > 4) ? (q<: >, map($_->dump, @to_unget)) : (),
- ") to be keepn'd.\n";
- last; # give up
- }
- # else keep while'ing along
- }
- # Now put it aaaaall back...
- $self->unget_token(@to_unget);
-
- } elsif( $tagname =~ m/^over-/s ) {
- push @stack, $1;
- push @indent_stack,
- int($token->attr('indent') * 4 * $self->normal_halfpoint_size);
- DEBUG and print "Indenting over $indent_stack[-1] twips.\n";
- $self->{'rtfindent'} += $indent_stack[-1];
-
- } elsif ($tagname eq 'L') {
- $tagname .= '=' . ($token->attr('type') || 'pod');
-
- } elsif ($tagname eq 'Data') {
- my $next = $self->get_token;
- next unless defined $next;
- unless( $next->type eq 'text' ) {
- $self->unget_token($next);
- next;
- }
- DEBUG and print " raw text ", $next->text, "\n";
- printf $fh "\n" . $next->text . "\n";
- next;
- }
-
- defined($scratch = $self->{'Tagmap'}{$tagname}) or next;
- $scratch =~ s/\#([^\#]+)\#/${$self}{$1}/g; # interpolate
- print $fh $scratch;
-
- if ($tagname eq 'item-number') {
- print $fh $token->attr('number'), ". \n";
- } elsif ($tagname eq 'item-bullet') {
- print $fh "\\'95 \n";
- #for funky testing: print $fh '', rtf_esc("\x{4E4B}\x{9053}");
- }
-
- } elsif( $type eq 'end' ) {
- DEBUG > 1 and print " -$type ",$token->tagname,"\n";
- if( ($tagname = $token->tagname) =~ m/^over-/s ) {
- DEBUG and print "Indenting back $indent_stack[-1] twips.\n";
- $self->{'rtfindent'} -= pop @indent_stack;
- pop @stack;
- } elsif( $tagname eq 'Verbatim' or $tagname eq 'VerbatimFormatted') {
- --$self->{'rtfverbatim'};
- }
- defined($scratch = $self->{'Tagmap'}{"/$tagname"}) or next;
- $scratch =~ s/\#([^\#]+)\#/${$self}{$1}/g; # interpolate
- print $fh $scratch;
- }
- }
- return 1;
-}
-
-#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-sub do_beginning {
- my $self = $_[0];
- my $fh = $self->{'output_fh'};
- return print $fh join '',
- $self->doc_init,
- $self->font_table,
- $self->stylesheet,
- $self->color_table,
- $self->doc_info,
- $self->doc_start,
- "\n"
- ;
-}
-
-sub do_end {
- my $self = $_[0];
- my $fh = $self->{'output_fh'};
- return print $fh '}'; # that should do it
-}
-
-###########################################################################
-
-sub stylesheet {
- return sprintf <<'END',
-{\stylesheet
-{\snext0 Normal;}
-{\*\cs10 \additive Default Paragraph Font;}
-{\*\cs16 \additive \i \sbasedon10 pod-I;}
-{\*\cs17 \additive \i\lang1024\noproof \sbasedon10 pod-F;}
-{\*\cs18 \additive \b \sbasedon10 pod-B;}
-{\*\cs19 \additive \f1\lang1024\noproof\sbasedon10 pod-C;}
-{\s20\ql \li0\ri0\sa180\widctlpar\f1\fs%s\lang1024\noproof\sbasedon0 \snext0 pod-codeblock;}
-{\*\cs21 \additive \lang1024\noproof \sbasedon10 pod-computerese;}
-{\*\cs22 \additive \i\lang1024\noproof\sbasedon10 pod-L-pod;}
-{\*\cs23 \additive \i\lang1024\noproof\sbasedon10 pod-L-url;}
-{\*\cs24 \additive \i\lang1024\noproof\sbasedon10 pod-L-man;}
-
-{\*\cs25 \additive \f1\lang1024\noproof\sbasedon0 pod-codelbock-plain;}
-{\*\cs26 \additive \f1\lang1024\noproof\sbasedon25 pod-codelbock-ital;}
-{\*\cs27 \additive \f1\lang1024\noproof\sbasedon25 pod-codelbock-bold;}
-{\*\cs28 \additive \f1\lang1024\noproof\sbasedon25 pod-codelbock-bold-ital;}
-
-{\s31\ql \keepn\sb90\sa180\f2\fs%s\ul\sbasedon0 \snext0 pod-head1;}
-{\s32\ql \keepn\sb90\sa180\f2\fs%s\ul\sbasedon0 \snext0 pod-head2;}
-{\s33\ql \keepn\sb90\sa180\f2\fs%s\ul\sbasedon0 \snext0 pod-head3;}
-{\s34\ql \keepn\sb90\sa180\f2\fs%s\ul\sbasedon0 \snext0 pod-head4;}
-}
-
-END
-
- $_[0]->codeblock_halfpoint_size(),
- $_[0]->head1_halfpoint_size(),
- $_[0]->head2_halfpoint_size(),
- $_[0]->head3_halfpoint_size(),
- $_[0]->head4_halfpoint_size(),
- ;
-}
-
-###########################################################################
-# Override these as necessary for further customization
-
-sub font_table {
- return <<'END'; # text font, code font, heading font
-{\fonttbl
-{\f0\froman Times New Roman;}
-{\f1\fmodern Courier New;}
-{\f2\fswiss Arial;}
-}
-
-END
-}
-
-sub doc_init {
- return <<'END';
-{\rtf1\ansi\deff0
-
-END
-}
-
-sub color_table {
- return <<'END';
-{\colortbl;\red255\green0\blue0;\red0\green0\blue255;}
-END
-}
-
-
-sub doc_info {
- my $self = $_[0];
-
- my $class = ref($self) || $self;
-
- my $tag = __PACKAGE__ . ' ' . $VERSION;
-
- unless($class eq __PACKAGE__) {
- $tag = " ($tag)";
- $tag = " v" . $self->VERSION . $tag if defined $self->VERSION;
- $tag = $class . $tag;
- }
-
- return sprintf <<'END',
-{\info{\doccomm
-%s
- using %s v%s
- under Perl v%s at %s GMT}
-{\author [see doc]}{\company [see doc]}{\operator [see doc]}
-}
-
-END
-
- # None of the following things should need escaping, I dare say!
- $tag,
- $ISA[0], $ISA[0]->VERSION(),
- $], scalar(gmtime),
- ;
-}
-
-sub doc_start {
- my $self = $_[0];
- my $title = $self->get_short_title();
- DEBUG and print "Short Title: <$title>\n";
- $title .= ' ' if length $title;
-
- $title =~ s/ *$/ /s;
- $title =~ s/^ //s;
- $title =~ s/ $/, /s;
- # make sure it ends in a comma and a space, unless it's 0-length
-
- my $is_obviously_module_name;
- $is_obviously_module_name = 1
- if $title =~ m/^\S+$/s and $title =~ m/::/s;
- # catches the most common case, at least
-
- DEBUG and print "Title0: <$title>\n";
- $title = rtf_esc($title);
- DEBUG and print "Title1: <$title>\n";
- $title = '\lang1024\noproof ' . $title
- if $is_obviously_module_name;
-
- return sprintf <<'END',
-\deflang%s\plain\lang%s\widowctrl
-{\header\pard\qr\plain\f2\fs%s
-%s
-p.\chpgn\par}
-\fs%s
-
-END
- ($self->doc_lang) x 2,
- $self->header_halfpoint_size,
- $title,
- $self->normal_halfpoint_size,
- ;
-}
-
-#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-#-------------------------------------------------------------------------
-
-use integer;
-sub rtf_esc {
- my $x; # scratch
- if(!defined wantarray) { # void context: alter in-place!
- for(@_) {
- s/([F\x00-\x1F\-\\\{\}\x7F-\xFF])/$Escape{$1}/g; # ESCAPER
- s/([^\x00-\xFF])/'\\uc1\\u'.((ord($1)<32768)?ord($1):(ord($1)-65536)).'?'/eg;
- }
- return;
- } elsif(wantarray) { # return an array
- return map {; ($x = $_) =~
- s/([F\x00-\x1F\-\\\{\}\x7F-\xFF])/$Escape{$1}/g; # ESCAPER
- $x =~ s/([^\x00-\xFF])/'\\uc1\\u'.((ord($1)<32768)?ord($1):(ord($1)-65536)).'?'/eg;
- $x;
- } @_;
- } else { # return a single scalar
- ($x = ((@_ == 1) ? $_[0] : join '', @_)
- ) =~ s/([F\x00-\x1F\-\\\{\}\x7F-\xFF])/$Escape{$1}/g; # ESCAPER
- # Escape \, {, }, -, control chars, and 7f-ff.
- $x =~ s/([^\x00-\xFF])/'\\uc1\\u'.((ord($1)<32768)?ord($1):(ord($1)-65536)).'?'/eg;
- return $x;
- }
-}
-
-sub rtf_esc_codely {
- # Doesn't change "-" to hard-hyphen, nor apply computerese style-smarts.
- # We don't want to change the "-" to hard-hyphen, because we want to
- # be able to paste this into a file and run it without there being
- # dire screaming about the mysterious hard-hyphen character (which
- # looks just like a normal dash character).
-
- my $x; # scratch
- if(!defined wantarray) { # void context: alter in-place!
- for(@_) {
- s/([F\x00-\x1F\\\{\}\x7F-\xFF])/$Escape{$1}/g; # ESCAPER
- s/([^\x00-\xFF])/'\\uc1\\u'.((ord($1)<32768)?ord($1):(ord($1)-65536)).'?'/eg;
- }
- return;
- } elsif(wantarray) { # return an array
- return map {; ($x = $_) =~
- s/([F\x00-\x1F\\\{\}\x7F-\xFF])/$Escape{$1}/g; # ESCAPER
- $x =~ s/([^\x00-\xFF])/'\\uc1\\u'.((ord($1)<32768)?ord($1):(ord($1)-65536)).'?'/eg;
- $x;
- } @_;
- } else { # return a single scalar
- ($x = ((@_ == 1) ? $_[0] : join '', @_)
- ) =~ s/([F\x00-\x1F\\\{\}\x7F-\xFF])/$Escape{$1}/g; # ESCAPER
- # Escape \, {, }, -, control chars, and 7f-ff.
- $x =~ s/([^\x00-\xFF])/'\\uc1\\u'.((ord($1)<32768)?ord($1):(ord($1)-65536)).'?'/eg;
- return $x;
- }
-}
-
-%Escape = (
- map( (chr($_),chr($_)), # things not apparently needing escaping
- 0x20 .. 0x7E ),
- map( (chr($_),sprintf("\\'%02x", $_)), # apparently escapeworthy things
- 0x00 .. 0x1F, 0x5c, 0x7b, 0x7d, 0x7f .. 0xFF, 0x46),
-
- # We get to escape out 'F' so that we can send RTF files thru the mail
- # without the slightest worry that paragraphs beginning with "From"
- # will get munged.
-
- # And some refinements:
- "\cm" => "\n",
- "\cj" => "\n",
- "\n" => "\n\\line ",
-
- "\t" => "\\tab ", # Tabs (altho theoretically raw \t's are okay)
- "\f" => "\n\\page\n", # Formfeed
- "-" => "\\_", # Turn plaintext '-' into a non-breaking hyphen
- "\xA0" => "\\~", # Latin-1 non-breaking space
- "\xAD" => "\\-", # Latin-1 soft (optional) hyphen
-
- # CRAZY HACKS:
- "\n" => "\\line\n",
- "\r" => "\n",
- "\cb" => "{\n\\cs21\\lang1024\\noproof ", # \\cf1
- "\cc" => "}",
-);
-1;
-
-__END__
-
-=head1 NAME
-
-Pod::Simple::RTF -- format Pod as RTF
-
-=head1 SYNOPSIS
-
- perl -MPod::Simple::RTF -e \
- "exit Pod::Simple::RTF->filter(shift)->any_errata_seen" \
- thingy.pod > thingy.rtf
-
-=head1 DESCRIPTION
-
-This class is a formatter that takes Pod and renders it as RTF, good for
-viewing/printing in MSWord, WordPad/write.exe, TextEdit, etc.
-
-This is a subclass of L<Pod::Simple> and inherits all its methods.
-
-=head1 FORMAT CONTROL ATTRIBUTES
-
-You can set these attributes on the parser object before you
-call C<parse_file> (or a similar method) on it:
-
-=over
-
-=item $parser->head1_halfpoint_size( I<halfpoint_integer> );
-
-=item $parser->head2_halfpoint_size( I<halfpoint_integer> );
-
-=item $parser->head3_halfpoint_size( I<halfpoint_integer> );
-
-=item $parser->head4_halfpoint_size( I<halfpoint_integer> );
-
-These methods set the size (in half-points, like 52 for 26-point)
-that these heading levels will appear as.
-
-=item $parser->codeblock_halfpoint_size( I<halfpoint_integer> );
-
-This method sets the size (in half-points, like 21 for 10.5-point)
-that codeblocks ("verbatim sections") will appear as.
-
-=item $parser->header_halfpoint_size( I<halfpoint_integer> );
-
-This method sets the size (in half-points, like 15 for 7.5-point)
-that the header on each page will appear in. The header
-is usually just "I<modulename> p. I<pagenumber>".
-
-=item $parser->normal_halfpoint_size( I<halfpoint_integer> );
-
-This method sets the size (in half-points, like 26 for 13-point)
-that normal paragraphic text will appear in.
-
-=item $parser->no_proofing_exemptions( I<true_or_false> );
-
-Set this value to true if you don't want the formatter to try
-putting a hidden code on all Perl symbols (as best as it can
-notice them) that labels them as being not in English, and
-so not worth spellchecking.
-
-=item $parser->doc_lang( I<microsoft_decimal_language_code> )
-
-This sets the language code to tag this document as being in. By
-default, it is currently the value of the environment variable
-C<RTFDEFLANG>, or if that's not set, then the value
-1033 (for US English).
-
-Setting this appropriately is useful if you want to use the RTF
-to spellcheck, and/or if you want it to hyphenate right.
-
-Here are some notable values:
-
- 1033 US English
- 2057 UK English
- 3081 Australia English
- 4105 Canada English
- 1034 Spain Spanish
- 2058 Mexico Spanish
- 1031 Germany German
- 1036 France French
- 3084 Canada French
- 1035 Finnish
- 1044 Norwegian (Bokmal)
- 2068 Norwegian (Nynorsk)
-
-=back
-
-If you are particularly interested in customizing this module's output
-even more, see the source and/or write to me.
-
-=head1 SEE ALSO
-
-L<Pod::Simple>, L<RTF::Writer>, L<RTF::Cookbook>, L<RTF::Document>,
-L<RTF::Generator>
-
-=head1 COPYRIGHT AND DISCLAIMERS
-
-Copyright (c) 2002 Sean M. Burke. All rights reserved.
-
-This library 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.
-
-=head1 AUTHOR
-
-Sean M. Burke C<sburke@cpan.org>
-
-=cut
-
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Pod/Simple/Search.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Pod/Simple/Search.pm
deleted file mode 100644
index 980b3b7739c..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Pod/Simple/Search.pm
+++ /dev/null
@@ -1,1016 +0,0 @@
-
-require 5.005;
-package Pod::Simple::Search;
-use strict;
-
-use vars qw($VERSION $MAX_VERSION_WITHIN $SLEEPY);
-$VERSION = 3.04; ## Current version of this package
-
-BEGIN { *DEBUG = sub () {0} unless defined &DEBUG; } # set DEBUG level
-use Carp ();
-
-$SLEEPY = 1 if !defined $SLEEPY and $^O =~ /mswin|mac/i;
- # flag to occasionally sleep for $SLEEPY - 1 seconds.
-
-$MAX_VERSION_WITHIN ||= 60;
-
-#############################################################################
-
-#use diagnostics;
-use File::Spec ();
-use File::Basename qw( basename );
-use Config ();
-use Cwd qw( cwd );
-
-#==========================================================================
-__PACKAGE__->_accessorize( # Make my dumb accessor methods
- 'callback', 'progress', 'dir_prefix', 'inc', 'laborious', 'limit_glob',
- 'limit_re', 'shadows', 'verbose', 'name2path', 'path2name',
-);
-#==========================================================================
-
-sub new {
- my $class = shift;
- my $self = bless {}, ref($class) || $class;
- $self->init;
- return $self;
-}
-
-sub init {
- my $self = shift;
- $self->inc(1);
- $self->verbose(DEBUG);
- return $self;
-}
-
-#--------------------------------------------------------------------------
-
-sub survey {
- my($self, @search_dirs) = @_;
- $self = $self->new unless ref $self; # tolerate being a class method
-
- $self->_expand_inc( \@search_dirs );
-
-
- $self->{'_scan_count'} = 0;
- $self->{'_dirs_visited'} = {};
- $self->path2name( {} );
- $self->name2path( {} );
- $self->limit_re( $self->_limit_glob_to_limit_re ) if $self->{'limit_glob'};
- my $cwd = cwd();
- my $verbose = $self->verbose;
- local $_; # don't clobber the caller's $_ !
-
- foreach my $try (@search_dirs) {
- unless( File::Spec->file_name_is_absolute($try) ) {
- # make path absolute
- $try = File::Spec->catfile( $cwd ,$try);
- }
- # simplify path
- $try = File::Spec->canonpath($try);
-
- my $start_in;
- my $modname_prefix;
- if($self->{'dir_prefix'}) {
- $start_in = File::Spec->catdir(
- $try,
- grep length($_), split '[\\/:]+', $self->{'dir_prefix'}
- );
- $modname_prefix = [grep length($_), split m{[:/\\]}, $self->{'dir_prefix'}];
- $verbose and print "Appending \"$self->{'dir_prefix'}\" to $try, ",
- "giving $start_in (= @$modname_prefix)\n";
- } else {
- $start_in = $try;
- }
-
- if( $self->{'_dirs_visited'}{$start_in} ) {
- $verbose and print "Directory '$start_in' already seen, skipping.\n";
- next;
- } else {
- $self->{'_dirs_visited'}{$start_in} = 1;
- }
-
- unless(-e $start_in) {
- $verbose and print "Skipping non-existent $start_in\n";
- next;
- }
-
- my $closure = $self->_make_search_callback;
-
- if(-d $start_in) {
- # Normal case:
- $verbose and print "Beginning excursion under $start_in\n";
- $self->_recurse_dir( $start_in, $closure, $modname_prefix );
- $verbose and print "Back from excursion under $start_in\n\n";
-
- } elsif(-f _) {
- # A excursion consisting of just one file!
- $_ = basename($start_in);
- $verbose and print "Pondering $start_in ($_)\n";
- $closure->($start_in, $_, 0, []);
-
- } else {
- $verbose and print "Skipping mysterious $start_in\n";
- }
- }
- $self->progress and $self->progress->done(
- "Noted $$self{'_scan_count'} Pod files total");
-
- return unless defined wantarray; # void
- return $self->name2path unless wantarray; # scalar
- return $self->name2path, $self->path2name; # list
-}
-
-
-#==========================================================================
-sub _make_search_callback {
- my $self = $_[0];
-
- # Put the options in variables, for easy access
- my( $laborious, $verbose, $shadows, $limit_re, $callback, $progress,$path2name,$name2path) =
- map scalar($self->$_()),
- qw(laborious verbose shadows limit_re callback progress path2name name2path);
-
- my($file, $shortname, $isdir, $modname_bits);
- return sub {
- ($file, $shortname, $isdir, $modname_bits) = @_;
-
- if($isdir) { # this never gets called on the startdir itself, just subdirs
-
- if( $self->{'_dirs_visited'}{$file} ) {
- $verbose and print "Directory '$file' already seen, skipping.\n";
- return 'PRUNE';
- }
-
- print "Looking in dir $file\n" if $verbose;
-
- unless ($laborious) { # $laborious overrides pruning
- if( m/^(\d+\.[\d_]{3,})\z/s
- and do { my $x = $1; $x =~ tr/_//d; $x != $] }
- ) {
- $verbose and print "Perl $] version mismatch on $_, skipping.\n";
- return 'PRUNE';
- }
-
- if( m/^([A-Za-z][a-zA-Z0-9_]*)\z/s ) {
- $verbose and print "$_ is a well-named module subdir. Looking....\n";
- } else {
- $verbose and print "$_ is a fishy directory name. Skipping.\n";
- return 'PRUNE';
- }
- } # end unless $laborious
-
- $self->{'_dirs_visited'}{$file} = 1;
- return; # (not pruning);
- }
-
-
- # Make sure it's a file even worth even considering
- if($laborious) {
- unless(
- m/\.(pod|pm|plx?)\z/i || -x _ and -T _
- # Note that the cheapest operation (the RE) is run first.
- ) {
- $verbose > 1 and print " Brushing off uninteresting $file\n";
- return;
- }
- } else {
- unless( m/^[-_a-zA-Z0-9]+\.(?:pod|pm|plx?)\z/is ) {
- $verbose > 1 and print " Brushing off oddly-named $file\n";
- return;
- }
- }
-
- $verbose and print "Considering item $file\n";
- my $name = $self->_path2modname( $file, $shortname, $modname_bits );
- $verbose > 0.01 and print " Nominating $file as $name\n";
-
- if($limit_re and $name !~ m/$limit_re/i) {
- $verbose and print "Shunning $name as not matching $limit_re\n";
- return;
- }
-
- if( !$shadows and $name2path->{$name} ) {
- $verbose and print "Not worth considering $file ",
- "-- already saw $name as ",
- join(' ', grep($path2name->{$_} eq $name, keys %$path2name)), "\n";
- return;
- }
-
- # Put off until as late as possible the expense of
- # actually reading the file:
- if( m/\.pod\z/is ) {
- # just assume it has pod, okay?
- } else {
- $progress and $progress->reach($self->{'_scan_count'}, "Scanning $file");
- return unless $self->contains_pod( $file );
- }
- ++ $self->{'_scan_count'};
-
- # Or finally take note of it:
- if( $name2path->{$name} ) {
- $verbose and print
- "Duplicate POD found (shadowing?): $name ($file)\n",
- " Already seen in ",
- join(' ', grep($path2name->{$_} eq $name, keys %$path2name)), "\n";
- } else {
- $name2path->{$name} = $file; # Noting just the first occurrence
- }
- $verbose and print " Noting $name = $file\n";
- if( $callback ) {
- local $_ = $_; # insulate from changes, just in case
- $callback->($file, $name);
- }
- $path2name->{$file} = $name;
- return;
- }
-}
-
-#==========================================================================
-
-sub _path2modname {
- my($self, $file, $shortname, $modname_bits) = @_;
-
- # this code simplifies the POD name for Perl modules:
- # * remove "site_perl"
- # * remove e.g. "i586-linux" (from 'archname')
- # * remove e.g. 5.00503
- # * remove pod/ if followed by perl*.pod (e.g. in pod/perlfunc.pod)
- # * dig into the file for case-preserved name if not already mixed case
-
- my @m = @$modname_bits;
- my $x;
- my $verbose = $self->verbose;
-
- # Shaving off leading naughty-bits
- while(@m
- and defined($x = lc( $m[0] ))
- and( $x eq 'site_perl'
- or($x eq 'pod' and @m == 1 and $shortname =~ m{^perl.*\.pod$}s )
- or $x =~ m{\\d+\\.z\\d+([_.]?\\d+)?} # if looks like a vernum
- or $x eq lc( $Config::Config{'archname'} )
- )) { shift @m }
-
- my $name = join '::', @m, $shortname;
- $self->_simplify_base($name);
-
- # On VMS, case-preserved document names can't be constructed from
- # filenames, so try to extract them from the "=head1 NAME" tag in the
- # file instead.
- if ($^O eq 'VMS' && ($name eq lc($name) || $name eq uc($name))) {
- open PODFILE, "<$file" or die "_path2modname: Can't open $file: $!";
- my $in_pod = 0;
- my $in_name = 0;
- my $line;
- while ($line = <PODFILE>) {
- chomp $line;
- $in_pod = 1 if ($line =~ m/^=\w/);
- $in_pod = 0 if ($line =~ m/^=cut/);
- next unless $in_pod; # skip non-pod text
- next if ($line =~ m/^\s*\z/); # and blank lines
- next if ($in_pod && ($line =~ m/^X</)); # and commands
- if ($in_name) {
- if ($line =~ m/(\w+::)?(\w+)/) {
- # substitute case-preserved version of name
- my $podname = $2;
- my $prefix = $1 || '';
- $verbose and print "Attempting case restore of '$name' from '$prefix$podname'\n";
- unless ($name =~ s/$prefix$podname/$prefix$podname/i) {
- $verbose and print "Attempting case restore of '$name' from '$podname'\n";
- $name =~ s/$podname/$podname/i;
- }
- last;
- }
- }
- $in_name = 1 if ($line =~ m/^=head1 NAME/);
- }
- close PODFILE;
- }
-
- return $name;
-}
-
-#==========================================================================
-
-sub _recurse_dir {
- my($self, $startdir, $callback, $modname_bits) = @_;
-
- my $maxdepth = $self->{'fs_recursion_maxdepth'} || 10;
- my $verbose = $self->verbose;
-
- my $here_string = File::Spec->curdir;
- my $up_string = File::Spec->updir;
- $modname_bits ||= [];
-
- my $recursor;
- $recursor = sub {
- my($dir_long, $dir_bare) = @_;
- if( @$modname_bits >= 10 ) {
- $verbose and print "Too deep! [@$modname_bits]\n";
- return;
- }
-
- unless(-d $dir_long) {
- $verbose > 2 and print "But it's not a dir! $dir_long\n";
- return;
- }
- unless( opendir(INDIR, $dir_long) ) {
- $verbose > 2 and print "Can't opendir $dir_long : $!\n";
- closedir(INDIR);
- return
- }
- my @items = sort readdir(INDIR);
- closedir(INDIR);
-
- push @$modname_bits, $dir_bare unless $dir_bare eq '';
-
- my $i_full;
- foreach my $i (@items) {
- next if $i eq $here_string or $i eq $up_string or $i eq '';
- $i_full = File::Spec->catfile( $dir_long, $i );
-
- if(!-r $i_full) {
- $verbose and print "Skipping unreadable $i_full\n";
-
- } elsif(-f $i_full) {
- $_ = $i;
- $callback->( $i_full, $i, 0, $modname_bits );
-
- } elsif(-d _) {
- $i =~ s/\.DIR\z//i if $^O eq 'VMS';
- $_ = $i;
- my $rv = $callback->( $i_full, $i, 1, $modname_bits ) || '';
-
- if($rv eq 'PRUNE') {
- $verbose > 1 and print "OK, pruning";
- } else {
- # Otherwise, recurse into it
- $recursor->( File::Spec->catdir($dir_long, $i) , $i);
- }
- } else {
- $verbose > 1 and print "Skipping oddity $i_full\n";
- }
- }
- pop @$modname_bits;
- return;
- };;
-
- local $_;
- $recursor->($startdir, '');
-
- undef $recursor; # allow it to be GC'd
-
- return;
-}
-
-
-#==========================================================================
-
-sub run {
- # A function, useful in one-liners
-
- my $self = __PACKAGE__->new;
- $self->limit_glob($ARGV[0]) if @ARGV;
- $self->callback( sub {
- my($file, $name) = @_;
- my $version = '';
-
- # Yes, I know we won't catch the version in like a File/Thing.pm
- # if we see File/Thing.pod first. That's just the way the
- # cookie crumbles. -- SMB
-
- if($file =~ m/\.pod$/i) {
- # Don't bother looking for $VERSION in .pod files
- DEBUG and print "Not looking for \$VERSION in .pod $file\n";
- } elsif( !open(INPOD, $file) ) {
- DEBUG and print "Couldn't open $file: $!\n";
- close(INPOD);
- } else {
- # Sane case: file is readable
- my $lines = 0;
- while(<INPOD>) {
- last if $lines++ > $MAX_VERSION_WITHIN; # some degree of sanity
- if( s/^\s*\$VERSION\s*=\s*//s and m/\d/ ) {
- DEBUG and print "Found version line (#$lines): $_";
- s/\s*\#.*//s;
- s/\;\s*$//s;
- s/\s+$//s;
- s/\t+/ /s; # nix tabs
- # Optimize the most common cases:
- $_ = "v$1"
- if m{^v?["']?([0-9_]+(\.[0-9_]+)*)["']?$}s
- # like in $VERSION = "3.14159";
- or m{\$Revision:\s*([0-9_]+(?:\.[0-9_]+)*)\s*\$}s
- # like in sprintf("%d.%02d", q$Revision: 4.13 $ =~ /(\d+)\.(\d+)/);
- ;
-
- # Like in sprintf("%d.%s", map {s/_//g; $_} q$Name: release-0_55-public $ =~ /-(\d+)_([\d_]+)/)
- $_ = sprintf("v%d.%s",
- map {s/_//g; $_}
- $1 =~ m/-(\d+)_([\d_]+)/) # snare just the numeric part
- if m{\$Name:\s*([^\$]+)\$}s
- ;
- $version = $_;
- DEBUG and print "Noting $version as version\n";
- last;
- }
- }
- close(INPOD);
- }
- print "$name\t$version\t$file\n";
- return;
- # End of callback!
- });
-
- $self->survey;
-}
-
-#==========================================================================
-
-sub simplify_name {
- my($self, $str) = @_;
-
- # Remove all path components
- # XXX Why not just use basename()? -- SMB
-
- if ($^O eq 'MacOS') { $str =~ s{^.*:+}{}s }
- else { $str =~ s{^.*/+}{}s }
-
- $self->_simplify_base($str);
- return $str;
-}
-
-#==========================================================================
-
-sub _simplify_base { # Internal method only
-
- # strip Perl's own extensions
- $_[1] =~ s/\.(pod|pm|plx?)\z//i;
-
- # strip meaningless extensions on Win32 and OS/2
- $_[1] =~ s/\.(bat|exe|cmd)\z//i if $^O =~ /mswin|os2/i;
-
- # strip meaningless extensions on VMS
- $_[1] =~ s/\.(com)\z//i if $^O eq 'VMS';
-
- return;
-}
-
-#==========================================================================
-
-sub _expand_inc {
- my($self, $search_dirs) = @_;
-
- return unless $self->{'inc'};
-
- if ($^O eq 'MacOS') {
- push @$search_dirs,
- grep $_ ne File::Spec->curdir, $self->_mac_whammy(@INC);
- # Any other OSs need custom handling here?
- } else {
- push @$search_dirs, grep $_ ne File::Spec->curdir, @INC;
- }
-
- $self->{'laborious'} = 0; # Since inc said to use INC
- return;
-}
-
-#==========================================================================
-
-sub _mac_whammy { # Tolerate '.', './some_dir' and '(../)+some_dir' on Mac OS
- my @them;
- (undef,@them) = @_;
- for $_ (@them) {
- if ( $_ eq '.' ) {
- $_ = ':';
- } elsif ( $_ =~ s|^((?:\.\./)+)|':' x (length($1)/3)|e ) {
- $_ = ':'. $_;
- } else {
- $_ =~ s|^\./|:|;
- }
- }
- return @them;
-}
-
-#==========================================================================
-
-sub _limit_glob_to_limit_re {
- my $self = $_[0];
- my $limit_glob = $self->{'limit_glob'} || return;
-
- my $limit_re = '^' . quotemeta($limit_glob) . '$';
- $limit_re =~ s/\\\?/./g; # glob "?" => "."
- $limit_re =~ s/\\\*/.*?/g; # glob "*" => ".*?"
- $limit_re =~ s/\.\*\?\$$//s; # final glob "*" => ".*?$" => ""
-
- $self->{'verbose'} and print "Turning limit_glob $limit_glob into re $limit_re\n";
-
- # A common optimization:
- if(!exists($self->{'dir_prefix'})
- and $limit_glob =~ m/^(?:\w+\:\:)+/s # like "File::*" or "File::Thing*"
- # Optimize for sane and common cases (but not things like "*::File")
- ) {
- $self->{'dir_prefix'} = join "::", $limit_glob =~ m/^(?:\w+::)+/sg;
- $self->{'verbose'} and print " and setting dir_prefix to $self->{'dir_prefix'}\n";
- }
-
- return $limit_re;
-}
-
-#==========================================================================
-
-# contribution mostly from Tim Jenness <t.jenness@jach.hawaii.edu>
-
-sub find {
- my($self, $pod, @search_dirs) = @_;
- $self = $self->new unless ref $self; # tolerate being a class method
-
- # Check usage
- Carp::carp 'Usage: \$self->find($podname, ...)'
- unless defined $pod and length $pod;
-
- my $verbose = $self->verbose;
-
- # Split on :: and then join the name together using File::Spec
- my @parts = split /::/, $pod;
- $verbose and print "Chomping {$pod} => {@parts}\n";
-
- #@search_dirs = File::Spec->curdir unless @search_dirs;
-
- if( $self->inc ) {
- if( $^O eq 'MacOS' ) {
- push @search_dirs, $self->_mac_whammy(@INC);
- } else {
- push @search_dirs, @INC;
- }
-
- # Add location of pod documentation for perl man pages (eg perlfunc)
- # This is a pod directory in the private install tree
- #my $perlpoddir = File::Spec->catdir($Config::Config{'installprivlib'},
- # 'pod');
- #push (@search_dirs, $perlpoddir)
- # if -d $perlpoddir;
-
- # Add location of binaries such as pod2text:
- push @search_dirs, $Config::Config{'scriptdir'};
- # and if that's undef or q{} or nonexistent, we just ignore it later
- }
-
- my %seen_dir;
- Dir:
- foreach my $dir ( @search_dirs ) {
- next unless defined $dir and length $dir;
- next if $seen_dir{$dir};
- $seen_dir{$dir} = 1;
- unless(-d $dir) {
- print "Directory $dir does not exist\n" if $verbose;
- next Dir;
- }
-
- print "Looking in directory $dir\n" if $verbose;
- my $fullname = File::Spec->catfile( $dir, @parts );
- print "Filename is now $fullname\n" if $verbose;
-
- foreach my $ext ('', '.pod', '.pm', '.pl') { # possible extensions
- my $fullext = $fullname . $ext;
- if( -f $fullext and $self->contains_pod( $fullext ) ){
- print "FOUND: $fullext\n" if $verbose;
- return $fullext;
- }
- }
- my $subdir = File::Spec->catdir($dir,'pod');
- if(-d $subdir) { # slip in the ./pod dir too
- $verbose and print "Noticing $subdir and stopping there...\n";
- $dir = $subdir;
- redo Dir;
- }
- }
-
- return undef;
-}
-
-#==========================================================================
-
-sub contains_pod {
- my($self, $file) = @_;
- my $verbose = $self->{'verbose'};
-
- # check for one line of POD
- $verbose > 1 and print " Scanning $file for pod...\n";
- unless( open(MAYBEPOD,"<$file") ) {
- print "Error: $file is unreadable: $!\n";
- return undef;
- }
-
- sleep($SLEEPY - 1) if $SLEEPY;
- # avoid totally hogging the processor on OSs with poor process control
-
- local $_;
- while( <MAYBEPOD> ) {
- if(m/^=(head\d|pod|over|item)\b/s) {
- close(MAYBEPOD) || die "Bizarre error closing $file: $!\nAborting";
- chomp;
- $verbose > 1 and print " Found some pod ($_) in $file\n";
- return 1;
- }
- }
- close(MAYBEPOD) || die "Bizarre error closing $file: $!\nAborting";
- $verbose > 1 and print " No POD in $file, skipping.\n";
- return 0;
-}
-
-#==========================================================================
-
-sub _accessorize { # A simple-minded method-maker
- shift;
- no strict 'refs';
- foreach my $attrname (@_) {
- *{caller() . '::' . $attrname} = sub {
- use strict;
- $Carp::CarpLevel = 1, Carp::croak(
- "Accessor usage: \$obj->$attrname() or \$obj->$attrname(\$new_value)"
- ) unless (@_ == 1 or @_ == 2) and ref $_[0];
-
- # Read access:
- return $_[0]->{$attrname} if @_ == 1;
-
- # Write access:
- $_[0]->{$attrname} = $_[1];
- return $_[0]; # RETURNS MYSELF!
- };
- }
- # Ya know, they say accessories make the ensemble!
- return;
-}
-
-#==========================================================================
-sub _state_as_string {
- my $self = $_[0];
- return '' unless ref $self;
- my @out = "{\n # State of $self ...\n";
- foreach my $k (sort keys %$self) {
- push @out, " ", _esc($k), " => ", _esc($self->{$k}), ",\n";
- }
- push @out, "}\n";
- my $x = join '', @out;
- $x =~ s/^/#/mg;
- return $x;
-}
-
-sub _esc {
- my $in = $_[0];
- return 'undef' unless defined $in;
- $in =~
- s<([^\x20\x21\x23\x27-\x3F\x41-\x5B\x5D-\x7E])>
- <'\\x'.(unpack("H2",$1))>eg;
- return qq{"$in"};
-}
-
-#==========================================================================
-
-run() unless caller; # run if "perl whatever/Search.pm"
-
-1;
-
-#==========================================================================
-
-__END__
-
-
-=head1 NAME
-
-Pod::Simple::Search - find POD documents in directory trees
-
-=head1 SYNOPSIS
-
- use Pod::Simple::Search;
- my $name2path = Pod::Simple::Search->new->limit_glob('LWP::*')->survey;
- print "Looky see what I found: ",
- join(' ', sort keys %$name2path), "\n";
-
- print "LWPUA docs = ",
- Pod::Simple::Search->new->find('LWP::UserAgent') || "?",
- "\n";
-
-=head1 DESCRIPTION
-
-B<Pod::Simple::Search> is a class that you use for running searches
-for Pod files. An object of this class has several attributes
-(mostly options for controlling search options), and some methods
-for searching based on those attributes.
-
-The way to use this class is to make a new object of this class,
-set any options, and then call one of the search options
-(probably C<survey> or C<find>). The sections below discuss the
-syntaxes for doing all that.
-
-
-=head1 CONSTRUCTOR
-
-This class provides the one constructor, called C<new>.
-It takes no parameters:
-
- use Pod::Simple::Search;
- my $search = Pod::Simple::Search->new;
-
-=head1 ACCESSORS
-
-This class defines several methods for setting (and, occasionally,
-reading) the contents of an object. With two exceptions (discussed at
-the end of this section), these attributes are just for controlling the
-way searches are carried out.
-
-Note that each of these return C<$self> when you call them as
-C<< $self->I<whatever(value)> >>. That's so that you can chain
-together set-attribute calls like this:
-
- my $name2path =
- Pod::Simple::Search->new
- -> inc(0) -> verbose(1) -> callback(\&blab)
- ->survey(@there);
-
-...which works exactly as if you'd done this:
-
- my $search = Pod::Simple::Search->new;
- $search->inc(0);
- $search->verbose(1);
- $search->callback(\&blab);
- my $name2path = $search->survey(@there);
-
-=over
-
-=item $search->inc( I<true-or-false> );
-
-This attribute, if set to a true value, means that searches should
-implicitly add perl's I<@INC> paths. This
-automatically considers paths specified in the C<PERL5LIB> environment
-as this is prepended to I<@INC> by the Perl interpreter itself.
-This attribute's default value is B<TRUE>. If you want to search
-only specific directories, set $self->inc(0) before calling
-$inc->survey or $inc->find.
-
-
-=item $search->verbose( I<nonnegative-number> );
-
-This attribute, if set to a nonzero positive value, will make searches output
-(via C<warn>) notes about what they're doing as they do it.
-This option may be useful for debugging a pod-related module.
-This attribute's default value is zero, meaning that no C<warn> messages
-are produced. (Setting verbose to 1 turns on some messages, and setting
-it to 2 turns on even more messages, i.e., makes the following search(es)
-even more verbose than 1 would make them.)
-
-
-=item $search->limit_glob( I<some-glob-string> );
-
-This option means that you want to limit the results just to items whose
-podnames match the given glob/wildcard expression. For example, you
-might limit your search to just "LWP::*", to search only for modules
-starting with "LWP::*" (but not including the module "LWP" itself); or
-you might limit your search to "LW*" to see only modules whose (full)
-names begin with "LW"; or you might search for "*Find*" to search for
-all modules with "Find" somewhere in their full name. (You can also use
-"?" in a glob expression; so "DB?" will match "DBI" and "DBD".)
-
-
-=item $search->callback( I<\&some_routine> );
-
-This attribute means that every time this search sees a matching
-Pod file, it should call this callback routine. The routine is called
-with two parameters: the current file's filespec, and its pod name.
-(For example: C<("/etc/perljunk/File/Crunk.pm", "File::Crunk")> would
-be in C<@_>.)
-
-The callback routine's return value is not used for anything.
-
-This attribute's default value is false, meaning that no callback
-is called.
-
-=item $search->laborious( I<true-or-false> );
-
-Unless you set this attribute to a true value, Pod::Search will
-apply Perl-specific heuristics to find the correct module PODs quickly.
-This attribute's default value is false. You won't normally need
-to set this to true.
-
-Specifically: Turning on this option will disable the heuristics for
-seeing only files with Perl-like extensions, omitting subdirectories
-that are numeric but do I<not> match the current Perl interpreter's
-version ID, suppressing F<site_perl> as a module hierarchy name, etc.
-
-
-=item $search->shadows( I<true-or-false> );
-
-Unless you set this attribute to a true value, Pod::Simple::Search will
-consider only the first file of a given modulename as it looks thru the
-specified directories; that is, with this option off, if
-Pod::Simple::Search has seen a C<somepathdir/Foo/Bar.pm> already in this
-search, then it won't bother looking at a C<somelaterpathdir/Foo/Bar.pm>
-later on in that search, because that file is merely a "shadow". But if
-you turn on C<< $self->shadows(1) >>, then these "shadow" files are
-inspected too, and are noted in the pathname2podname return hash.
-
-This attribute's default value is false; and normally you won't
-need to turn it on.
-
-
-=item $search->limit_re( I<some-regxp> );
-
-Setting this attribute (to a value that's a regexp) means that you want
-to limit the results just to items whose podnames match the given
-regexp. Normally this option is not needed, and the more efficient
-C<limit_glob> attribute is used instead.
-
-
-=item $search->dir_prefix( I<some-string-value> );
-
-Setting this attribute to a string value means that the searches should
-begin in the specified subdirectory name (like "Pod" or "File::Find",
-also expressable as "File/Find"). For example, the search option
-C<< $search->limit_glob("File::Find::R*") >>
-is the same as the combination of the search options
-C<< $search->limit_re("^File::Find::R") -> dir_prefix("File::Find") >>.
-
-Normally you don't need to know about the C<dir_prefix> option, but I
-include it in case it might prove useful for someone somewhere.
-
-(Implementationally, searching with limit_glob ends up setting limit_re
-and usually dir_prefix.)
-
-
-=item $search->progress( I<some-progress-object> );
-
-If you set a value for this attribute, the value is expected
-to be an object (probably of a class that you define) that has a
-C<reach> method and a C<done> method. This is meant for reporting
-progress during the search, if you don't want to use a simple
-callback.
-
-Normally you don't need to know about the C<progress> option, but I
-include it in case it might prove useful for someone somewhere.
-
-While a search is in progress, the progress object's C<reach> and
-C<done> methods are called like this:
-
- # Every time a file is being scanned for pod:
- $progress->reach($count, "Scanning $file"); ++$count;
-
- # And then at the end of the search:
- $progress->done("Noted $count Pod files total");
-
-Internally, we often set this to an object of class
-Pod::Simple::Progress. That class is probably undocumented,
-but you may wish to look at its source.
-
-
-=item $name2path = $self->name2path;
-
-This attribute is not a search parameter, but is used to report the
-result of C<survey> method, as discussed in the next section.
-
-=item $path2name = $self->path2name;
-
-This attribute is not a search parameter, but is used to report the
-result of C<survey> method, as discussed in the next section.
-
-=back
-
-=head1 MAIN SEARCH METHODS
-
-Once you've actually set any options you want (if any), you can go
-ahead and use the following methods to search for Pod files
-in particular ways.
-
-
-=head2 C<< $search->survey( @directories ) >>
-
-The method C<survey> searches for POD documents in a given set of
-files and/or directories. This runs the search according to the various
-options set by the accessors above. (For example, if the C<inc> attribute
-is on, as it is by default, then the perl @INC directories are implicitly
-added to the list of directories (if any) that you specify.)
-
-The return value of C<survey> is two hashes:
-
-=over
-
-=item C<name2path>
-
-A hash that maps from each pod-name to the filespec (like
-"Stuff::Thing" => "/whatever/plib/Stuff/Thing.pm")
-
-=item C<path2name>
-
-A hash that maps from each Pod filespec to its pod-name (like
-"/whatever/plib/Stuff/Thing.pm" => "Stuff::Thing")
-
-=back
-
-Besides saving these hashes as the hashref attributes
-C<name2path> and C<path2name>, calling this function also returns
-these hashrefs. In list context, the return value of
-C<< $search->survey >> is the list C<(\%name2path, \%path2name)>.
-In scalar context, the return value is C<\%name2path>.
-Or you can just call this in void context.
-
-Regardless of calling context, calling C<survey> saves
-its results in its C<name2path> and C<path2name> attributes.
-
-E.g., when searching in F<$HOME/perl5lib>, the file
-F<$HOME/perl5lib/MyModule.pm> would get the POD name I<MyModule>,
-whereas F<$HOME/perl5lib/Myclass/Subclass.pm> would be
-I<Myclass::Subclass>. The name information can be used for POD
-translators.
-
-Only text files containing at least one valid POD command are found.
-
-In verbose mode, a warning is printed if shadows are found (i.e., more
-than one POD file with the same POD name is found, e.g. F<CPAN.pm> in
-different directories). This usually indicates duplicate occurrences of
-modules in the I<@INC> search path, which is occasionally inadvertent
-(but is often simply a case of a user's path dir having a more recent
-version than the system's general path dirs in general.)
-
-The options to this argument is a list of either directories that are
-searched recursively, or files. (Usually you wouldn't specify files,
-but just dirs.) Or you can just specify an empty-list, as in
-$name2path; with the
-C<inc> option on, as it is by default, teh
-
-The POD names of files are the plain basenames with any Perl-like
-extension (.pm, .pl, .pod) stripped, and path separators replaced by
-C<::>'s.
-
-Calling Pod::Simple::Search->search(...) is short for
-Pod::Simple::Search->new->search(...). That is, a throwaway object
-with default attribute values is used.
-
-
-=head2 C<< $search->simplify_name( $str ) >>
-
-The method B<simplify_name> is equivalent to B<basename>, but also
-strips Perl-like extensions (.pm, .pl, .pod) and extensions like
-F<.bat>, F<.cmd> on Win32 and OS/2, or F<.com> on VMS, respectively.
-
-
-=head2 C<< $search->find( $pod ) >>
-
-=head2 C<< $search->find( $pod, @search_dirs ) >>
-
-Returns the location of a Pod file, given a Pod/module/script name
-(like "Foo::Bar" or "perlvar" or "perldoc"), and an idea of
-what files/directories to look in.
-It searches according to the various options set by the accessors above.
-(For example, if the C<inc> attribute is on, as it is by default, then
-the perl @INC directories are implicitly added to the list of
-directories (if any) that you specify.)
-
-This returns the full path of the first occurrence to the file.
-Package names (eg 'A::B') are automatically converted to directory
-names in the selected directory. Additionally, '.pm', '.pl' and '.pod'
-are automatically appended to the search as required.
-(So, for example, under Unix, "A::B" is converted to "somedir/A/B.pm",
-"somedir/A/B.pod", or "somedir/A/B.pl", as appropriate.)
-
-If no such Pod file is found, this method returns undef.
-
-If any of the given search directories contains a F<pod/> subdirectory,
-then it is searched. (That's how we manage to find F<perlfunc>,
-for example, which is usually in F<pod/perlfunc> in most Perl dists.)
-
-The C<verbose> and C<inc> attributes influence the behavior of this
-search; notably, C<inc>, if true, adds @INC I<and also
-$Config::Config{'scriptdir'}> to the list of directories to search.
-
-It is common to simply say C<< $filename = Pod::Simple::Search-> new
-->find("perlvar") >> so that just the @INC (well, and scriptdir)
-directories are searched. (This happens because the C<inc>
-attribute is true by default.)
-
-Calling Pod::Simple::Search->find(...) is short for
-Pod::Simple::Search->new->find(...). That is, a throwaway object
-with default attribute values is used.
-
-
-=head2 C<< $self->contains_pod( $file ) >>
-
-Returns true if the supplied filename (not POD module) contains some Pod
-documentation.
-
-
-=head1 AUTHOR
-
-Sean M. Burke E<lt>sburke@cpan.orgE<gt>
-borrowed code from
-Marek Rouchal's Pod::Find, which in turn
-heavily borrowed code from Nick Ing-Simmons' PodToHtml.
-
-Tim Jenness E<lt>t.jenness@jach.hawaii.eduE<gt> provided
-C<find> and C<contains_pod> to Pod::Find.
-
-=head1 SEE ALSO
-
-L<Pod::Simple>, L<Pod::Perldoc>
-
-=cut
-
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Pod/Simple/SimpleTree.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Pod/Simple/SimpleTree.pm
deleted file mode 100644
index 64dd155104a..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Pod/Simple/SimpleTree.pm
+++ /dev/null
@@ -1,155 +0,0 @@
-
-
-require 5;
-package Pod::Simple::SimpleTree;
-use strict;
-use Carp ();
-use Pod::Simple ();
-use vars qw( $ATTR_PAD @ISA $VERSION $SORT_ATTRS);
-$VERSION = '2.02';
-BEGIN {
- @ISA = ('Pod::Simple');
- *DEBUG = \&Pod::Simple::DEBUG unless defined &DEBUG;
-}
-
-__PACKAGE__->_accessorize(
- 'root', # root of the tree
-);
-
-#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-sub _handle_element_start { # self, tagname, attrhash
- DEBUG > 2 and print "Handling $_[1] start-event\n";
- my $x = [$_[1], $_[2]];
- if($_[0]{'_currpos'}) {
- push @{ $_[0]{'_currpos'}[0] }, $x; # insert in parent's child-list
- unshift @{ $_[0]{'_currpos'} }, $x; # prefix to stack
- } else {
- DEBUG and print " And oo, it gets to be root!\n";
- $_[0]{'_currpos'} = [ $_[0]{'root'} = $x ];
- # first event! set to stack, and set as root.
- }
- DEBUG > 3 and print "Stack is now: ",
- join(">", map $_->[0], @{$_[0]{'_currpos'}}), "\n";
- return;
-}
-
-sub _handle_element_end { # self, tagname
- DEBUG > 2 and print "Handling $_[1] end-event\n";
- shift @{$_[0]{'_currpos'}};
- DEBUG > 3 and print "Stack is now: ",
- join(">", map $_->[0], @{$_[0]{'_currpos'}}), "\n";
- return;
-}
-
-sub _handle_text { # self, text
- DEBUG > 2 and print "Handling $_[1] text-event\n";
- push @{ $_[0]{'_currpos'}[0] }, $_[1];
- return;
-}
-
-
-# A bit of evil from the black box... please avert your eyes, kind souls.
-sub _traverse_treelet_bit {
- DEBUG > 2 and print "Handling $_[1] paragraph event\n";
- my $self = shift;
- push @{ $self->{'_currpos'}[0] }, [@_];
- return;
-}
-#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-1;
-__END__
-
-=head1 NAME
-
-Pod::Simple::SimpleTree -- parse Pod into a simple parse tree
-
-=head1 SYNOPSIS
-
- % cat ptest.pod
-
- =head1 PIE
-
- I like B<pie>!
-
- % perl -MPod::Simple::SimpleTree -MData::Dumper -e \
- "print Dumper(Pod::Simple::SimpleTree->new->parse_file(shift)->root)" \
- ptest.pod
-
- $VAR1 = [
- 'Document',
- { 'start_line' => 1 },
- [
- 'head1',
- { 'start_line' => 1 },
- 'PIE'
- ],
- [
- 'Para',
- { 'start_line' => 3 },
- 'I like ',
- [
- 'B',
- {},
- 'pie'
- ],
- '!'
- ]
- ];
-
-=head1 DESCRIPTION
-
-This class is of interest to people writing a Pod processor/formatter.
-
-This class takes Pod and parses it, returning a parse tree made just
-of arrayrefs, and hashrefs, and strings.
-
-This is a subclass of L<Pod::Simple> and inherits all its methods.
-
-This class is inspired by XML::Parser's "Tree" parsing-style, although
-it doesn't use exactly the same LoL format.
-
-=head1 METHODS
-
-At the end of the parse, call C<< $parser->root >> to get the
-tree's top node.
-
-=head1 Tree Contents
-
-Every element node in the parse tree is represented by an arrayref of
-the form: C<[ I<elementname>, \%attributes, I<...subnodes...> ]>.
-See the example tree dump in the Synopsis, above.
-
-Every text node in the tree is represented by a simple (non-ref)
-string scalar. So you can test C<ref($node)> to see whather you have
-an element node or just a text node.
-
-The top node in the tree is C<[ 'Document', \%attributes,
-I<...subnodes...> ]>
-
-
-=head1 SEE ALSO
-
-L<Pod::Simple>
-
-L<perllol>
-
-L<The "Tree" subsubsection in XML::Parser|XML::Parser/"Tree">
-
-=head1 COPYRIGHT AND DISCLAIMERS
-
-Copyright (c) 2002 Sean M. Burke. All rights reserved.
-
-This library 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.
-
-=head1 AUTHOR
-
-Sean M. Burke C<sburke@cpan.org>
-
-=cut
-
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Pod/Simple/Subclassing.pod b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Pod/Simple/Subclassing.pod
deleted file mode 100644
index d4ee6943444..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Pod/Simple/Subclassing.pod
+++ /dev/null
@@ -1,922 +0,0 @@
-
-=head1 NAME
-
-Pod::Simple::Subclassing -- write a formatter as a Pod::Simple subclass
-
-=head1 SYNOPSIS
-
- package Pod::SomeFormatter;
- use Pod::Simple;
- @ISA = qw(Pod::Simple);
- $VERSION = '1.01';
- use strict;
-
- sub _handle_element_start {
- my($parser, $element_name, $attr_hash_r) = @_;
- ...
- }
-
- sub _handle_element_end {
- my($parser, $element_name) = @_;
- ...
- }
-
- sub _handle_text {
- my($parser, $text) = @_;
- ...
- }
- 1;
-
-=head1 DESCRIPTION
-
-This document is about using Pod::Simple to write a Pod processor,
-generally a Pod formatter. If you just want to know about using an
-existing Pod formatter, instead see its documentation and see also the
-docs in L<Pod::Simple>.
-
-The zeroeth step in writing a Pod formatter is to make sure that there
-isn't already a decent one in CPAN. See L<http://search.cpan.org/>, and
-run a search on the name of the format you want to render to. Also
-consider joining the Pod People list
-L<http://lists.perl.org/showlist.cgi?name=pod-people> and asking whether
-anyone has a formatter for that format -- maybe someone cobbled one
-together but just hasn't released it.
-
-The first step in writing a Pod processor is to read L<perlpodspec>,
-which contains notes information on writing a Pod parser (which has been
-largely taken care of by Pod::Simple), but also a lot of requirements
-and recommendations for writing a formatter.
-
-The second step is to actually learn the format you're planning to
-format to -- or at least as much as you need to know to represent Pod,
-which probably isn't much.
-
-The third step is to pick which of Pod::Simple's interfaces you want to
-use -- the basic interface via Pod::Simple or L<Pod::Simple::Methody> is
-event-based, sort of like L<HTML::Parser>'s interface, or sort of like
-L<XML::Parser>'s "Handlers" interface), but L<Pod::Simple::PullParser>
-provides a token-stream interface, sort of like L<HTML::TokeParser>'s
-interface; L<Pod::Simple::SimpleTree> provides a simple tree interface,
-rather like XML::Parser's "Tree" interface. Users familiar with
-XML-handling will find one of these styles relatively familiar; but if
-you would be even more at home with XML, there are classes that produce
-an XML representation of the Pod stream, notably
-L<Pod::Simple::XMLOutStream>; you can feed the output of such a class to
-whatever XML parsing system you are most at home with.
-
-The last step is to write your code based on how the events (or tokens,
-or tree-nodes, or the XML, or however you're parsing) will map to
-constructs in the output format. Also sure to consider how to escape
-text nodes containing arbitrary text, and also what to do with text
-nodes that represent preformatted text (from verbatim sections).
-
-
-
-=head1 Events
-
-TODO intro... mention that events are supplied for implicits, like for
-missing >'s
-
-
-In the following section, we use XML to represent the event structure
-associated with a particular construct. That is, TODO
-
-=over
-
-=item C<< $parser->_handle_element_start( I<element_name>, I<attr_hashref> ) >>
-
-=item C<< $parser->_handle_element_end( I<element_name> ) >>
-
-=item C<< $parser->_handle_text( I<text_string> ) >>
-
-=back
-
-TODO describe
-
-
-=over
-
-=item events with an element_name of Document
-
-Parsing a document produces this event structure:
-
- <Document start_line="543">
- ...all events...
- </Document>
-
-The value of the I<start_line> attribute will be the line number of the first
-Pod directive in the document.
-
-If there is no Pod in the given document, then the
-event structure will be this:
-
- <Document contentless="1" start_line="543">
- </Document>
-
-In that case, the value of the I<start_line> attribute will not be meaningful;
-under current implementations, it will probably be the line number of the
-last line in the file.
-
-=item events with an element_name of Para
-
-Parsing a plain (non-verbatim, non-directive, non-data) paragraph in
-a Pod document produces this event structure:
-
- <Para start_line="543">
- ...all events in this paragraph...
- </Para>
-
-The value of the I<start_line> attribute will be the line number of the start
-of the paragraph.
-
-For example, parsing this paragraph of Pod:
-
- The value of the I<start_line> attribute will be the
- line number of the start of the paragraph.
-
-produces this event structure:
-
- <Para start_line="129">
- The value of the
- <I>
- start_line
- </I>
- attribute will be the line number of the first Pod directive
- in the document.
- </Para>
-
-=item events with an element_name of B, C, F, or I.
-
-Parsing a BE<lt>...E<gt> formatting code (or of course any of its
-semantically identical syntactic variants
-S<BE<lt>E<lt> ... E<gt>E<gt>>,
-or S<BE<lt>E<lt>E<lt>E<lt> ... E<gt>E<gt>E<gt>E<gt>>, etc.)
-produces this event structure:
-
- <B>
- ...stuff...
- </B>
-
-Currently, there are no attributes conveyed.
-
-Parsing C, F, or I codes produce the same structure, with only a
-different element name.
-
-If your parser object has been set to accept other formatting codes,
-then they will be presented like these B/C/F/I codes -- i.e., without
-any attributes.
-
-=item events with an element_name of S
-
-Normally, parsing an SE<lt>...E<gt> sequence produces this event
-structure, just as if it were a B/C/F/I code:
-
- <S>
- ...stuff...
- </S>
-
-However, Pod::Simple (and presumably all derived parsers) offers the
-C<nbsp_for_S> option which, if enabled, will suppress all S events, and
-instead change all spaces in the content to non-breaking spaces. This is
-intended for formatters that output to a format that has no code that
-means the same as SE<lt>...E<gt>, but which has a code/character that
-means non-breaking space.
-
-=item events with an element_name of X
-
-Normally, parsing an XE<lt>...E<gt> sequence produces this event
-structure, just as if it were a B/C/F/I code:
-
- <X>
- ...stuff...
- </X>
-
-However, Pod::Simple (and presumably all derived parsers) offers the
-C<nix_X_codes> option which, if enabled, will suppress all X events
-and ignore their content. For formatters/processors that don't use
-X events, this is presumably quite useful.
-
-
-=item events with an element_name of L
-
-Because the LE<lt>...E<gt> is the most complex construct in the
-language, it should not surprise you that the events it generates are
-the most complex in the language. Most of complexity is hidden away in
-the attribute values, so for those of you writing a Pod formatter that
-produces a non-hypertextual format, you can just ignore the attributes
-and treat an L event structure like a formatting element that
-(presumably) doesn't actually produce a change in formatting. That is,
-the content of the L event structure (as opposed to its
-attributes) is always what text should be displayed.
-
-There are, at first glance, three kinds of L links: URL, man, and pod.
-
-When a LE<lt>I<some_url>E<gt> code is parsed, it produces this event
-structure:
-
- <L content-implicit="yes" to="that_url" type="url">
- that_url
- </L>
-
-The C<type="url"> attribute is always specified for this type of
-L code.
-
-For example, this Pod source:
-
- L<http://www.perl.com/CPAN/authors/>
-
-produces this event structure:
-
- <L content-implicit="yes" to="http://www.perl.com/CPAN/authors/" type="url">
- http://www.perl.com/CPAN/authors/
- </L>
-
-When a LE<lt>I<manpage(section)>E<gt> code is parsed (and these are
-fairly rare and not terribly useful), it produces this event structure:
-
- <L content-implicit="yes" to="manpage(section)" type="man">
- manpage(section)
- </L>
-
-The C<type="man"> attribute is always specified for this type of
-L code.
-
-For example, this Pod source:
-
- L<crontab(5)>
-
-produces this event structure:
-
- <L content-implicit="yes" to="crontab(5)" type="man">
- crontab(5)
- </L>
-
-In the rare cases where a man page link has a specified, that text appears
-in a I<section> attribute. For example, this Pod source:
-
- L<crontab(5)/"ENVIRONMENT">
-
-will produce this event structure:
-
- <L content-implicit="yes" section="ENVIRONMENT" to="crontab(5)" type="man">
- "ENVIRONMENT" in crontab(5)
- </L>
-
-In the rare case where the Pod document has code like
-LE<lt>I<sometext>|I<manpage(section)>E<gt>, then the I<sometext> will appear
-as the content of the element, the I<manpage(section)> text will appear
-only as the value of the I<to> attribute, and there will be no
-C<content-implicit="yes"> attribute (whose presence means that the Pod parser
-had to infer what text should appear as the link text -- as opposed to
-cases where that attribute is absent, which means that the Pod parser did
-I<not> have to infer the link text, because that L code explicitly specified
-some link text.)
-
-For example, this Pod source:
-
- L<hell itself!|crontab(5)>
-
-will produce this event structure:
-
- <L to="crontab(5)" type="man">
- hell itself!
- </L>
-
-The last type of L structure is for links to/within Pod documents. It is
-the most complex because it can have a I<to> attribute, I<or> a
-I<section> attribute, or both. The C<type="pod"> attribute is always
-specified for this type of L code.
-
-In the most common case, the simple case of a LE<lt>podpageE<gt> code
-produces this event structure:
-
- <L content-implicit="yes" to="Net::Ping" type="pod">
- podpage
- </L>
-
-For example, this Pod source:
-
- L<Net::Ping>
-
-produces this event structure:
-
- <L content-implicit="yes" to="Net::Ping" type="pod">
- Net::Ping
- </L>
-
-In cases where there is link-text explicitly specified, it
-is to be found in the content of the element (and not the
-attributes), just as with the LE<lt>I<sometext>|I<manpage(section)>E<gt>
-case discussed above. For example, this Pod source:
-
- L<Perl Error Messages|perldiag>
-
-produces this event structure:
-
- <L to="perldiag" type="pod">
- Perl Error Messages
- </L>
-
-In cases of links to a section in the current Pod document,
-there is a I<section> attribute instead of a I<to> attribute.
-For example, this Pod source:
-
- L</"Member Data">
-
-produces this event structure:
-
- <L content-implicit="yes" section="Member Data" type="pod">
- "Member Data"
- </L>
-
-As another example, this Pod source:
-
- L<the various attributes|/"Member Data">
-
-produces this event structure:
-
- <L section="Member Data" type="pod">
- the various attributes
- </L>
-
-In cases of links to a section in a different Pod document,
-there are both a I<section> attribute and a L<to> attribute.
-For example, this Pod source:
-
- L<perlsyn/"Basic BLOCKs and Switch Statements">
-
-produces this event structure:
-
- <L content-implicit="yes" section="Basic BLOCKs and Switch Statements" to="perlsyn" type="pod">
- "Basic BLOCKs and Switch Statements" in perlsyn
- </L>
-
-As another example, this Pod source:
-
- L<SWITCH statements|perlsyn/"Basic BLOCKs and Switch Statements">
-
-produces this event structure:
-
- <L section="Basic BLOCKs and Switch Statements" to="perlsyn" type="pod">
- SWITCH statements
- </L>
-
-Incidentally, note that we do not distinguish between these syntaxes:
-
- L</"Member Data">
- L<"Member Data">
- L</Member Data>
- L<Member Data> [deprecated syntax]
-
-That is, they all produce the same event structure, namely:
-
- <L content-implicit="yes" section="Member Data" type="pod">
- &#34;Member Data&#34;
- </L>
-
-=item events with an element_name of E or Z
-
-While there are Pod codes EE<lt>...E<gt> and ZE<lt>E<gt>, these
-I<do not> produce any E or Z events -- that is, there are no such
-events as E or Z.
-
-=item events with an element_name of Verbatim
-
-When a Pod verbatim paragraph (AKA "codeblock") is parsed, it
-produces this event structure:
-
- <Verbatim start_line="543" xml:space="preserve">
- ...text...
- </Verbatim>
-
-The value of the I<start_line> attribute will be the line number of the
-first line of this verbatim block. The I<xml:space> attribute is always
-present, and always has the value "preserve".
-
-The text content will have tabs already expanded.
-
-
-=item events with an element_name of head1 .. head4
-
-When a "=head1 ..." directive is parsed, it produces this event
-structure:
-
- <head1>
- ...stuff...
- </head1>
-
-For example, a directive consisting of this:
-
- =head1 Options to C<new> et al.
-
-will produce this event structure:
-
- <head1 start_line="543">
- Options to
- <C>
- new
- </C>
- et al.
- </head1>
-
-"=head2" thru "=head4" directives are the same, except for the element
-names in the event structure.
-
-=item events with an element_name of over-bullet
-
-When an "=over ... Z<>=back" block is parsed where the items are
-a bulletted list, it will produce this event structure:
-
- <over-bullet indent="4" start_line="543">
- <item-bullet start_line="545">
- ...Stuff...
- </item-bullet>
- ...more item-bullets...
- </over-bullet>
-
-The value of the I<indent> attribute is whatever value is after the
-"=over" directive, as in "=over 8". If no such value is specified
-in the directive, then the I<indent> attribute has the value "4".
-
-For example, this Pod source:
-
- =over
-
- =item *
-
- Stuff
-
- =item *
-
- Bar I<baz>!
-
- =back
-
-produces this event structure:
-
- <over-bullet indent="4" start_line="10">
- <item-bullet start_line="12">
- Stuff
- </item-bullet>
- <item-bullet start_line="14">
- Bar <I>baz</I>!
- </item-bullet>
- </over-bullet>
-
-=item events with an element_name of over-number
-
-When an "=over ... Z<>=back" block is parsed where the items are
-a numbered list, it will produce this event structure:
-
- <over-number indent="4" start_line="543">
- <item-number number="1" start_line="545">
- ...Stuff...
- </item-number>
- ...more item-number...
- </over-bullet>
-
-This is like the "over-bullet" event structure; but note that the contents
-are "item-number" instead of "item-bullet", and note that they will have
-a "number" attribute, which some formatters/processors may ignore
-(since, for example, there's no need for it in HTML when producing
-an "<UL><LI>...</LI>...</UL>" structure), but which any processor may use.
-
-Note that the values for the I<number> attributes of "item-number"
-elements in a given "over-number" area I<will> start at 1 and go up by
-one each time. If the Pod source doesn't follow that order (even though
-it really should should!), whatever numbers it has will be ignored (with
-the correct values being put in the I<number> attributes), and an error
-message might be issued to the user.
-
-=item events with an element_name of over-text
-
-These events are are somewhat unlike the other over-*
-structures, as far as what their contents are. When
-an "=over ... Z<>=back" block is parsed where the items are
-a list of text "subheadings", it will produce this event structure:
-
- <over-text indent="4" start_line="543">
- <item-text>
- ...stuff...
- </item-text>
- ...stuff (generally Para or Verbatim elements)...
- <item-text>
- ...more item-text and/or stuff...
- </over-text>
-
-The I<indent> attribute is as with the other over-* events.
-
-For example, this Pod source:
-
- =over
-
- =item Foo
-
- Stuff
-
- =item Bar I<baz>!
-
- Quux
-
- =back
-
-produces this event structure:
-
- <over-text indent="4" start_line="20">
- <item-text start_line="22">
- Foo
- </item-text>
- <Para start_line="24">
- Stuff
- </Para>
- <item-text start_line="26">
- Bar
- <I>
- baz
- </I>
- !
- </item-text>
- <Para start_line="28">
- Quux
- </Para>
- </over-text>
-
-
-
-=item events with an element_name of over-block
-
-These events are are somewhat unlike the other over-*
-structures, as far as what their contents are. When
-an "=over ... Z<>=back" block is parsed where there are no items,
-it will produce this event structure:
-
- <over-block indent="4" start_line="543">
- ...stuff (generally Para or Verbatim elements)...
- </over-block>
-
-The I<indent> attribute is as with the other over-* events.
-
-For example, this Pod source:
-
- =over
-
- For cutting off our trade with all parts of the world
-
- For transporting us beyond seas to be tried for pretended offenses
-
- He is at this time transporting large armies of foreign mercenaries to
- complete the works of death, desolation and tyranny, already begun with
- circumstances of cruelty and perfidy scarcely paralleled in the most
- barbarous ages, and totally unworthy the head of a civilized nation.
-
- =cut
-
-will produce this event structure:
-
- <over-block indent="4" start_line="2">
- <Para start_line="4">
- For cutting off our trade with all parts of the world
- </Para>
- <Para start_line="6">
- For transporting us beyond seas to be tried for pretended offenses
- </Para>
- <Para start_line="8">
- He is at this time transporting large armies of [...more text...]
- </Para>
- </over-block>
-
-=item events with an element_name of item-bullet
-
-See L</"events with an element_name of over-bullet">, above.
-
-=item events with an element_name of item-number
-
-See L</"events with an element_name of over-number">, above.
-
-=item events with an element_name of item-text
-
-See L</"events with an element_name of over-text">, above.
-
-=item events with an element_name of for
-
-TODO...
-
-=item events with an element_name of Data
-
-TODO...
-
-=back
-
-
-
-=head1 More Pod::Simple Methods
-
-Pod::Simple provides a lot of methods that aren't generally interesting
-to the end user of an existing Pod formatter, but some of which you
-might find useful in writing a Pod formatter. They are listed below. The
-first several methods (the accept_* methods) are for declaring the
-capabilites of your parser, notably what C<=for I<targetname>> sections
-it's interested in, what extra NE<lt>...E<gt> codes it accepts beyond
-the ones described in the I<perlpod>.
-
-=over
-
-=item C<< $parser->accept_targets( I<SOMEVALUE> ) >>
-
-As the parser sees sections like:
-
- =for html <img src="fig1.jpg">
-
-or
-
- =begin html
-
- <img src="fig1.jpg">
-
- =end html
-
-...the parser will ignore these sections unless your subclass has
-specified that it wants to see sections targetted to "html" (or whatever
-the formatter name is).
-
-If you want to process all sections, even if they're not targetted for you,
-call this before you start parsing:
-
- $parser->accept_targets('*');
-
-=item C<< $parser->accept_targets_as_text( I<SOMEVALUE> ) >>
-
-This is like accept_targets, except that it specifies also that the
-content of sections for this target should be treated as Pod text even
-if the target name in "=for I<targetname>" doesn't start with a ":".
-
-At time of writing, I don't think you'll need to use this.
-
-
-=item C<< $parser->accept_codes( I<Codename>, I<Codename>... ) >>
-
-This tells the parser that you accept additional formatting codes,
-beyond just the standard ones (I B C L F S X, plus the two weird ones
-you don't actually see in the parse tree, Z and E). For example, to also
-accept codes "N", "R", and "W":
-
- $parser->accept_codes( qw( N R W ) );
-
-B<TODO: document how this interacts with =extend, and long element names>
-
-
-=item C<< $parser->accept_directive_as_data( I<directive_name> ) >>
-
-=item C<< $parser->accept_directive_as_verbatim( I<directive_name> ) >>
-
-=item C<< $parser->accept_directive_as_processed( I<directive_name> ) >>
-
-In the unlikely situation that you need to tell the parser that you will
-accept additional directives ("=foo" things), you need to first set the
-parset to treat its content as data (i.e., not really processed at
-all), or as verbatim (mostly just expanding tabs), or as processed text
-(parsing formatting codes like BE<lt>...E<gt>).
-
-For example, to accept a new directive "=method", you'd presumably
-use:
-
- $parser->accept_directive_as_processed("method");
-
-so that you could have Pod lines like:
-
- =method I<$whatever> thing B<um>
-
-Making up your own directives breaks compatibility with other Pod
-formatters, in a way that using "=for I<target> ..." lines doesn't;
-however, you may find this useful if you're making a Pod superset
-format where you don't need to worry about compatibility.
-
-
-=item C<< $parser->nbsp_for_S( I<BOOLEAN> ); >>
-
-Setting this attribute to a true value (and by default it is false) will
-turn "SE<lt>...E<gt>" sequences into sequences of words separated by
-C<\xA0> (non-breaking space) characters. For example, it will take this:
-
- I like S<Dutch apple pie>, don't you?
-
-and treat it as if it were:
-
- I like DutchE<nbsp>appleE<nbsp>pie, don't you?
-
-This is handy for output formats that don't have anything quite like an
-"SE<lt>...E<gt>" code, but which do have a code for non-breaking space.
-
-There is currently no method for going the other way; but I can
-probably provide one upon request.
-
-
-=item C<< $parser->version_report() >>
-
-This returns a string reporting the $VERSION value from your module (and
-its classname) as well as the $VERSION value of Pod::Simple. Note that
-L<perlpodspec> requires output formats (wherever possible) to note
-this detail in a comment in the output format. For example, for
-some kind of SGML output format:
-
- print OUT "<!-- \n", $parser->version_report, "\n -->";
-
-
-=item C<< $parser->pod_para_count() >>
-
-This returns the count of Pod paragraphs seen so far.
-
-
-=item C<< $parser->line_count() >>
-
-This is the current line number being parsed. But you might find the
-"line_number" event attribute more accurate, when it is present.
-
-
-=item C<< $parser->nix_X_codes( I<SOMEVALUE> ) >>
-
-This attribute, when set to a true value (and it is false by default)
-ignores any "XE<lt>...E<gt>" sequences in the document being parsed.
-Many formats don't actually use the content of these codes, so have
-no reason to process them.
-
-
-=item C<< $parser->merge_text( I<SOMEVALUE> ) >>
-
-This attribute, when set to a true value (and it is false by default)
-makes sure that only one event (or token, or node) will be created
-for any single contiguous sequence of text. For example, consider
-this somewhat contrived example:
-
- I just LOVE Z<>hotE<32>apple pie!
-
-When that is parsed and events are about to be called on it, it may
-actually seem to be four different text events, one right after another:
-one event for "I just LOVE ", one for "hot", one for " ", and one for
-"apple pie!". But if you have merge_text on, then you're guaranteed
-that it will be fired as one text event: "I just LOVE hot apple pie!".
-
-
-=item C<< $parser->code_handler( I<CODE_REF> ) >>
-
-This specifies code that should be called when a code line is seen
-(i.e., a line outside of the Pod). Normally this is undef, meaning
-that no code should be called. If you provide a routine, it should
-start out like this:
-
- sub get_code_line { # or whatever you'll call it
- my($line, $line_number, $parser) = @_;
- ...
- }
-
-Note, however, that sometimes the Pod events aren't processed in exactly
-the same order as the code lines are -- i.e., if you have a file with
-Pod, then code, then more Pod, sometimes the code will be processed (via
-whatever you have code_handler call) before the all of the preceding Pod
-has been processed.
-
-
-=item C<< $parser->cut_handler( I<CODE_REF> ) >>
-
-This is just like the code_handler attribute, except that it's for
-"=cut" lines, not code lines. The same caveats apply. "=cut" lines are
-unlikely to be interesting, but this is included for completeness.
-
-
-=item C<< $parser->whine( I<linenumber>, I<complaint string> ) >>
-
-This notes a problem in the Pod, which will be reported to in the "Pod
-Errors" section of the document and/or send to STDERR, depending on the
-values of the attributes C<no_whining>, C<no_errata_section>, and
-C<complain_stderr>.
-
-=item C<< $parser->scream( I<linenumber>, I<complaint string> ) >>
-
-This notes an error like C<whine> does, except that it is not
-suppressable with C<no_whining>. This should be used only for very
-serious errors.
-
-
-=item C<< $parser->source_dead(1) >>
-
-This aborts parsing of the current document, by switching on the flag
-that indicates that EOF has been seen. In particularly drastic cases,
-you might want to do this. It's rather nicer than just calling
-C<die>!
-
-=item C<< $parser->hide_line_numbers( I<SOMEVALUE> ) >>
-
-Some subclasses that indescriminately dump event attributes (well,
-except for ones beginning with "~") can use this object attribute for
-refraining to dump the "start_line" attribute.
-
-=item C<< $parser->no_whining( I<SOMEVALUE> ) >>
-
-This attribute, if set to true, will suppress reports of non-fatal
-error messages. The default value is false, meaning that complaints
-I<are> reported. How they get reported depends on the values of
-the attributes C<no_errata_section> and C<complain_stderr>.
-
-=item C<< $parser->no_errata_section( I<SOMEVALUE> ) >>
-
-This attribute, if set to true, will suppress generation of an errata
-section. The default value is false -- i.e., an errata section will be
-generated.
-
-=item C<< $parser->complain_stderr( I<SOMEVALUE> ) >>
-
-This attribute, if set to true will send complaints to STDERR. The
-default value is false -- i.e., complaints do not go to STDERR.
-
-=item C<< $parser->bare_output( I<SOMEVALUE> ) >>
-
-Some formatter subclasses use this as a flag for whether output should
-have prologue and epilogue code omitted. For example, setting this to
-true for an HTML formatter class should omit the
-"<html><head><title>...</title><body>..." prologue and the
-"</body></html>" epilogue.
-
-If you want to set this to true, you should probably also set
-C<no_whining> or at least C<no_errata_section> to true.
-
-=item C<< $parser->preserve_whitespace( I<SOMEVALUE> ) >>
-
-If you set this attribute to a true value, the parser will try to
-preserve whitespace in the output. This means that such formatting
-conventions as two spaces after periods will be preserved by the parser.
-This is primarily useful for output formats that treat whitespace as
-significant (such as text or *roff, but not HTML).
-
-=back
-
-
-=head1 SEE ALSO
-
-L<Pod::Simple> -- event-based Pod-parsing framework
-
-L<Pod::Simple::Methody> -- like Pod::Simple, but each sort of event
-calls its own method (like C<start_head3>)
-
-L<Pod::Simple::PullParser> -- a Pod-parsing framework like Pod::Simple,
-but with a token-stream interface
-
-L<Pod::Simple::SimpleTree> -- a Pod-parsing framework like Pod::Simple,
-but with a tree interface
-
-L<Pod::Simple::Checker> -- a simple Pod::Simple subclass that reads
-documents, and then makes a plaintext report of any errors found in the
-document
-
-L<Pod::Simple::DumpAsXML> -- for dumping Pod documents as tidily
-indented XML, showing each event on its own line
-
-L<Pod::Simple::XMLOutStream> -- dumps a Pod document as XML (without
-introducing extra whitespace as Pod::Simple::DumpAsXML does).
-
-L<Pod::Simple::DumpAsText> -- for dumping Pod documents as tidily
-indented text, showing each event on its own line
-
-L<Pod::Simple::LinkSection> -- class for objects representing the values
-of the TODO and TODO attributes of LE<lt>...E<gt> elements
-
-L<Pod::Escapes> -- the module the Pod::Simple uses for evaluating
-EE<lt>...E<gt> content
-
-L<Pod::Simple::Text> -- a simple plaintext formatter for Pod
-
-L<Pod::Simple::TextContent> -- like Pod::Simple::Text, but
-makes no effort for indent or wrap the text being formatted
-
-L<perlpod|perlpod>
-
-L<perlpodspec|perlpodspec>
-
-L<perldoc>
-
-
-=head1 COPYRIGHT AND DISCLAIMERS
-
-Copyright (c) 2002 Sean M. Burke. All rights reserved.
-
-This library 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.
-
-=head1 AUTHOR
-
-Sean M. Burke C<sburke@cpan.org>
-
-
-=for notes
-Hm, my old podchecker version (1.2) says:
- *** WARNING: node 'http://search.cpan.org/' contains non-escaped | or / at line 38 in file Subclassing.pod
- *** WARNING: node 'http://lists.perl.org/showlist.cgi?name=pod-people' contains non-escaped | or / at line 41 in file Subclassing.pod
-Yes, L<...> is hard.
-
-
-=cut
-
-
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Pod/Simple/Text.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Pod/Simple/Text.pm
deleted file mode 100644
index df82c0784c8..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Pod/Simple/Text.pm
+++ /dev/null
@@ -1,152 +0,0 @@
-
-require 5;
-package Pod::Simple::Text;
-use strict;
-use Carp ();
-use Pod::Simple::Methody ();
-use Pod::Simple ();
-use vars qw( @ISA $VERSION $FREAKYMODE);
-$VERSION = '2.02';
-@ISA = ('Pod::Simple::Methody');
-BEGIN { *DEBUG = defined(&Pod::Simple::DEBUG)
- ? \&Pod::Simple::DEBUG
- : sub() {0}
- }
-
-use Text::Wrap 98.112902 ();
-$Text::Wrap::wrap = 'overflow';
-#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-sub new {
- my $self = shift;
- my $new = $self->SUPER::new(@_);
- $new->{'output_fh'} ||= *STDOUT{IO};
- $new->accept_target_as_text(qw( text plaintext plain ));
- $new->nix_X_codes(1);
- $new->nbsp_for_S(1);
- $new->{'Thispara'} = '';
- $new->{'Indent'} = 0;
- $new->{'Indentstring'} = ' ';
- return $new;
-}
-
-#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-sub handle_text { $_[0]{'Thispara'} .= $_[1] }
-
-sub start_Para { $_[0]{'Thispara'} = '' }
-sub start_head1 { $_[0]{'Thispara'} = '' }
-sub start_head2 { $_[0]{'Thispara'} = '' }
-sub start_head3 { $_[0]{'Thispara'} = '' }
-sub start_head4 { $_[0]{'Thispara'} = '' }
-
-sub start_Verbatim { $_[0]{'Thispara'} = '' }
-sub start_item_bullet { $_[0]{'Thispara'} = $FREAKYMODE ? '' : '* ' }
-sub start_item_number { $_[0]{'Thispara'} = $FREAKYMODE ? '' : "$_[1]{'number'}. " }
-sub start_item_text { $_[0]{'Thispara'} = '' }
-
-sub start_over_bullet { ++$_[0]{'Indent'} }
-sub start_over_number { ++$_[0]{'Indent'} }
-sub start_over_text { ++$_[0]{'Indent'} }
-sub start_over_block { ++$_[0]{'Indent'} }
-
-sub end_over_bullet { --$_[0]{'Indent'} }
-sub end_over_number { --$_[0]{'Indent'} }
-sub end_over_text { --$_[0]{'Indent'} }
-sub end_over_block { --$_[0]{'Indent'} }
-
-
-# . . . . . Now the actual formatters:
-
-sub end_head1 { $_[0]->emit_par(-4) }
-sub end_head2 { $_[0]->emit_par(-3) }
-sub end_head3 { $_[0]->emit_par(-2) }
-sub end_head4 { $_[0]->emit_par(-1) }
-sub end_Para { $_[0]->emit_par( 0) }
-sub end_item_bullet { $_[0]->emit_par( 0) }
-sub end_item_number { $_[0]->emit_par( 0) }
-sub end_item_text { $_[0]->emit_par(-2) }
-
-sub emit_par {
- my($self, $tweak_indent) = splice(@_,0,2);
- my $indent = ' ' x ( 2 * $self->{'Indent'} + 4 + ($tweak_indent||0) );
- # Yes, 'STRING' x NEGATIVE gives '', same as 'STRING' x 0
-
- $self->{'Thispara'} =~ tr{\xAD}{}d if Pod::Simple::ASCII;
- my $out = Text::Wrap::wrap($indent, $indent, $self->{'Thispara'} .= "\n");
- $out =~ tr{\xA0}{ } if Pod::Simple::ASCII;
- print {$self->{'output_fh'}} $out, "\n";
- $self->{'Thispara'} = '';
-
- return;
-}
-
-# . . . . . . . . . . And then off by its lonesome:
-
-sub end_Verbatim {
- my $self = shift;
- if(Pod::Simple::ASCII) {
- $self->{'Thispara'} =~ tr{\xA0}{ };
- $self->{'Thispara'} =~ tr{\xAD}{}d;
- }
-
- my $i = ' ' x ( 2 * $self->{'Indent'} + 4);
- #my $i = ' ' x (4 + $self->{'Indent'});
-
- $self->{'Thispara'} =~ s/^/$i/mg;
-
- print { $self->{'output_fh'} } '',
- $self->{'Thispara'},
- "\n\n"
- ;
- $self->{'Thispara'} = '';
- return;
-}
-
-#@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
-1;
-
-
-__END__
-
-=head1 NAME
-
-Pod::Simple::Text -- format Pod as plaintext
-
-=head1 SYNOPSIS
-
- perl -MPod::Simple::Text -e \
- "exit Pod::Simple::Text->filter(shift)->any_errata_seen" \
- thingy.pod
-
-=head1 DESCRIPTION
-
-This class is a formatter that takes Pod and renders it as
-wrapped plaintext.
-
-Its wrapping is done by L<Text::Wrap>, so you can change
-C<$Text::Wrap::columns> as you like.
-
-This is a subclass of L<Pod::Simple> and inherits all its methods.
-
-=head1 SEE ALSO
-
-L<Pod::Simple>, L<Pod::Simple::TextContent>, L<Pod::Text>
-
-=head1 COPYRIGHT AND DISCLAIMERS
-
-Copyright (c) 2002 Sean M. Burke. All rights reserved.
-
-This library 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.
-
-=head1 AUTHOR
-
-Sean M. Burke C<sburke@cpan.org>
-
-=cut
-
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Pod/Simple/TextContent.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Pod/Simple/TextContent.pm
deleted file mode 100644
index 3675b005ef1..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Pod/Simple/TextContent.pm
+++ /dev/null
@@ -1,87 +0,0 @@
-
-
-require 5;
-package Pod::Simple::TextContent;
-use strict;
-use Carp ();
-use Pod::Simple ();
-use vars qw( @ISA $VERSION );
-$VERSION = '2.02';
-@ISA = ('Pod::Simple');
-
-sub new {
- my $self = shift;
- my $new = $self->SUPER::new(@_);
- $new->{'output_fh'} ||= *STDOUT{IO};
- $new->nix_X_codes(1);
- return $new;
-}
-
-#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-sub _handle_element_start {
- print {$_[0]{'output_fh'}} "\n" unless $_[1] =~ m/^[A-Z]$/s;
- return;
-}
-
-sub _handle_text {
- if( chr(65) eq 'A' ) { # in ASCIIworld
- $_[1] =~ tr/\xAD//d;
- $_[1] =~ tr/\xA0/ /;
- }
- print {$_[0]{'output_fh'}} $_[1];
- return;
-}
-
-sub _handle_element_end {
- print {$_[0]{'output_fh'}} "\n" unless $_[1] =~ m/^[A-Z]$/s;
- return;
-}
-
-#@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
-1;
-
-
-__END__
-
-=head1 NAME
-
-Pod::Simple::TextContent -- get the text content of Pod
-
-=head1 SYNOPSIS
-
- TODO
-
- perl -MPod::Simple::TextContent -e \
- "exit Pod::Simple::TextContent->filter(shift)->any_errata_seen" \
- thingy.pod
-
-=head1 DESCRIPTION
-
-This class is that parses Pod and dumps just the text content. It is
-mainly meant for use by the Pod::Simple test suite, but you may find
-some other use for it.
-
-This is a subclass of L<Pod::Simple> and inherits all its methods.
-
-=head1 SEE ALSO
-
-L<Pod::Simple>, L<Pod::Simple::Text>, L<Pod::Spell>
-
-=head1 COPYRIGHT AND DISCLAIMERS
-
-Copyright (c) 2002 Sean M. Burke. All rights reserved.
-
-This library 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.
-
-=head1 AUTHOR
-
-Sean M. Burke C<sburke@cpan.org>
-
-=cut
-
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Pod/Simple/TiedOutFH.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Pod/Simple/TiedOutFH.pm
deleted file mode 100644
index b031fe5869b..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Pod/Simple/TiedOutFH.pm
+++ /dev/null
@@ -1,103 +0,0 @@
-
-use strict;
-package Pod::Simple::TiedOutFH;
-use Symbol ('gensym');
-use Carp ();
-
-#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-sub handle_on { # some horrible frightening things are encapsulated in here
- my $class = shift;
- $class = ref($class) || $class;
-
- Carp::croak "Usage: ${class}->handle_on(\$somescalar)" unless @_;
-
- my $x = (defined($_[0]) and ref($_[0]))
- ? $_[0]
- : ( \( $_[0] ) )[0]
- ;
- $$x = '' unless defined $$x;
-
- #Pod::Simple::DEBUG and print "New $class handle on $x = \"$$x\"\n";
-
- my $new = gensym();
- tie *$new, $class, $x;
- return $new;
-}
-
-#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-sub TIEHANDLE { # Ties to just a scalar ref
- my($class, $scalar_ref) = @_;
- $$scalar_ref = '' unless defined $$scalar_ref;
- return bless \$scalar_ref, ref($class) || $class;
-}
-
-sub PRINT {
- my $it = shift;
- foreach my $x (@_) { $$$it .= $x }
-
- #Pod::Simple::DEBUG > 10 and print " appended to $$it = \"$$$it\"\n";
-
- return 1;
-}
-
-sub FETCH {
- return ${$_[0]};
-}
-
-sub PRINTF {
- my $it = shift;
- my $format = shift;
- $$$it .= sprintf $format, @_;
- return 1;
-}
-
-sub FILENO { ${ $_[0] } + 100 } # just to produce SOME number
-
-sub CLOSE { 1 }
-
-#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-1;
-__END__
-
-Chole
-
- * 1 large red onion
- * 2 tomatillos
- * 4 or 5 roma tomatoes (optionally with the pulp discarded)
- * 1 tablespoons chopped ginger root (or more, to taste)
- * 2 tablespoons canola oil (or vegetable oil)
-
- * 1 tablespoon garam masala
- * 1/2 teaspoon red chili powder, or to taste
- * Salt, to taste (probably quite a bit)
- * 2 (15-ounce) cans chick peas or garbanzo beans, drained and rinsed
- * juice of one smallish lime
- * a dash of balsamic vinegar (to taste)
- * cooked rice, preferably long-grain white rice (whether plain,
- basmati rice, jasmine rice, or even a mild pilaf)
-
-In a blender or food processor, puree the onions, tomatoes, tomatillos,
-and ginger root. You can even do it with a Braun hand "mixer", if you
-chop things finer to start with, and work at it.
-
-In a saucepan set over moderate heat, warm the oil until hot.
-
-Add the puree and the balsamic vinegar, and cook, stirring occasionally,
-for 20 to 40 minutes. (Cooking it longer will make it sweeter.)
-
-Add the Garam Masala, chili powder, and cook, stirring occasionally, for
-5 minutes.
-
-Add the salt and chick peas and cook, stirring, until heated through.
-
-Stir in the lime juice, and optionally one or two teaspoons of tahini.
-You can let it simmer longer, depending on how much softer you want the
-garbanzos to get.
-
-Serve over rice, like a curry.
-
-Yields 5 to 7 servings.
-
-
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Pod/Simple/Transcode.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Pod/Simple/Transcode.pm
deleted file mode 100644
index 434f963388b..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Pod/Simple/Transcode.pm
+++ /dev/null
@@ -1,33 +0,0 @@
-
-require 5;
-package Pod::Simple::Transcode;
-
-BEGIN {
- if(defined &DEBUG) {;} # Okay
- elsif( defined &Pod::Simple::DEBUG ) { *DEBUG = \&Pod::Simple::DEBUG; }
- else { *DEBUG = sub () {0}; }
-}
-
-foreach my $class (
- 'Pod::Simple::TranscodeSmart',
- 'Pod::Simple::TranscodeDumb',
- '',
-) {
- $class or die "Couldn't load any encoding classes";
- DEBUG and print "About to try loading $class...\n";
- eval "require $class;";
- if($@) {
- DEBUG and print "Couldn't load $class: $@\n";
- } else {
- DEBUG and print "OK, loaded $class.\n";
- @ISA = ($class);
- last;
- }
-}
-
-sub _blorp { return; } # just to avoid any "empty class" warning
-
-1;
-__END__
-
-
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Pod/Simple/TranscodeDumb.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Pod/Simple/TranscodeDumb.pm
deleted file mode 100644
index d5eb7e5fb8c..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Pod/Simple/TranscodeDumb.pm
+++ /dev/null
@@ -1,63 +0,0 @@
-
-require 5;
-## This module is to be use()'d only by Pod::Simple::Transcode
-
-package Pod::Simple::TranscodeDumb;
-use strict;
-use vars qw($VERSION %Supported);
-$VERSION = '2.02';
-# This module basically pretends it knows how to transcode, except
-# only for null-transcodings! We use this when Encode isn't
-# available.
-
-%Supported = (
- 'ascii' => 1,
- 'ascii-ctrl' => 1,
- 'iso-8859-1' => 1,
- 'null' => 1,
- 'latin1' => 1,
- 'latin-1' => 1,
- %Supported,
-);
-
-sub is_dumb {1}
-sub is_smart {0}
-
-sub all_encodings {
- return sort keys %Supported;
-}
-
-sub encoding_is_available {
- return exists $Supported{lc $_[1]};
-}
-
-sub encmodver {
- return __PACKAGE__ . " v" .($VERSION || '?');
-}
-
-sub make_transcoder {
- my($e) = $_[1];
- die "WHAT ENCODING!?!?" unless $e;
- my $x;
- return sub {;
- #foreach $x (@_) {
- # if(Pod::Simple::ASCII and !Pod::Simple::UNICODE and $] > 5.005) {
- # # We're in horrible gimp territory, so we need to knock out
- # # all the highbit things
- # $x =
- # pack 'C*',
- # map {; ($_ < 128) ? $_ : 0x7e }
- # unpack "C*",
- # $x
- # ;
- # }
- #}
- #
- #return;
- };
-}
-
-
-1;
-
-
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Pod/Simple/TranscodeSmart.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Pod/Simple/TranscodeSmart.pm
deleted file mode 100644
index 3fc26a4a260..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Pod/Simple/TranscodeSmart.pm
+++ /dev/null
@@ -1,42 +0,0 @@
-
-require 5;
-use 5.008;
-## Anything before 5.8.0 is GIMPY!
-## This module is to be use()'d only by Pod::Simple::Transcode
-
-package Pod::Simple::TranscodeSmart;
-use strict;
-use Pod::Simple;
-require Encode;
-
-sub is_dumb {0}
-sub is_smart {1}
-
-sub all_encodings {
- return Encode::->encodings(':all');
-}
-
-sub encoding_is_available {
- return Encode::resolve_alias($_[1]);
-}
-
-sub encmodver {
- return "Encode.pm v" .($Encode::VERSION || '?');
-}
-
-sub make_transcoder {
- my($e) = $_[1];
- die "WHAT ENCODING!?!?" unless $e;
- my $x;
- return sub {
- foreach $x (@_) {
- $x = Encode::decode($e, $x);
- }
- return;
- };
-}
-
-
-1;
-
-
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Pod/Simple/XMLOutStream.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Pod/Simple/XMLOutStream.pm
deleted file mode 100644
index 1e7ec15d9a7..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Pod/Simple/XMLOutStream.pm
+++ /dev/null
@@ -1,157 +0,0 @@
-
-require 5;
-package Pod::Simple::XMLOutStream;
-use strict;
-use Carp ();
-use Pod::Simple ();
-use vars qw( $ATTR_PAD @ISA $VERSION $SORT_ATTRS);
-$VERSION = '2.02';
-BEGIN {
- @ISA = ('Pod::Simple');
- *DEBUG = \&Pod::Simple::DEBUG unless defined &DEBUG;
-}
-
-$ATTR_PAD = "\n" unless defined $ATTR_PAD;
- # Don't mess with this unless you know what you're doing.
-
-$SORT_ATTRS = 0 unless defined $SORT_ATTRS;
-
-sub new {
- my $self = shift;
- my $new = $self->SUPER::new(@_);
- $new->{'output_fh'} ||= *STDOUT{IO};
- #$new->accept_codes('VerbatimFormatted');
- return $new;
-}
-
-#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-sub _handle_element_start {
- # ($self, $element_name, $attr_hash_r)
- my $fh = $_[0]{'output_fh'};
- my($key, $value);
- DEBUG and print "++ $_[1]\n";
- print $fh "<", $_[1];
- if($SORT_ATTRS) {
- foreach my $key (sort keys %{$_[2]}) {
- unless($key =~ m/^~/s) {
- next if $key eq 'start_line' and $_[0]{'hide_line_numbers'};
- _xml_escape($value = $_[2]{$key});
- print $fh $ATTR_PAD, $key, '="', $value, '"';
- }
- }
- } else { # faster
- while(($key,$value) = each %{$_[2]}) {
- unless($key =~ m/^~/s) {
- next if $key eq 'start_line' and $_[0]{'hide_line_numbers'};
- _xml_escape($value);
- print $fh $ATTR_PAD, $key, '="', $value, '"';
- }
- }
- }
- print $fh ">";
- return;
-}
-
-sub _handle_text {
- DEBUG and print "== \"$_[1]\"\n";
- if(length $_[1]) {
- my $text = $_[1];
- _xml_escape($text);
- print {$_[0]{'output_fh'}} $text;
- }
- return;
-}
-
-sub _handle_element_end {
- DEBUG and print "-- $_[1]\n";
- print {$_[0]{'output_fh'}} "</", $_[1], ">";
- return;
-}
-
-# . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
-#@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
-
-sub _xml_escape {
- foreach my $x (@_) {
- # Escape things very cautiously:
- $x =~ s/([^-\n\t !\#\$\%\(\)\*\+,\.\~\/\:\;=\?\@\[\\\]\^_\`\{\|\}abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789])/'&#'.(ord($1)).';'/eg;
- # Yes, stipulate the list without a range, so that this can work right on
- # all charsets that this module happens to run under.
- # Altho, hmm, what about that ord? Presumably that won't work right
- # under non-ASCII charsets. Something should be done about that.
- }
- return;
-}
-
-#@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
-1;
-
-__END__
-
-=head1 NAME
-
-Pod::Simple::XMLOutStream -- turn Pod into XML
-
-=head1 SYNOPSIS
-
- perl -MPod::Simple::XMLOutStream -e \
- "exit Pod::Simple::XMLOutStream->filter(shift)->any_errata_seen" \
- thingy.pod
-
-=head1 DESCRIPTION
-
-Pod::Simple::XMLOutStream is a subclass of L<Pod::Simple> that parses
-Pod and turns it into XML.
-
-Pod::Simple::XMLOutStream inherits methods from
-L<Pod::Simple>.
-
-
-=head1 SEE ALSO
-
-L<Pod::Simple::DumpAsXML> is rather like this class; see its
-documentation for a discussion of the differences.
-
-L<Pod::Simple>, L<Pod::Simple::DumpAsXML>, L<Pod::SAX>
-
-L<Pod::Simple::Subclassing>
-
-The older (and possibly obsolete) libraries L<Pod::PXML>, L<Pod::XML>
-
-
-=head1 ABOUT EXTENDING POD
-
-TODO: An example or two of =extend, then point to Pod::Simple::Subclassing
-
-
-=head1 ASK ME!
-
-If you actually want to use Pod as a format that you want to render to
-XML (particularly if to an XML instance with more elements than normal
-Pod has), please email me (C<sburke@cpan.org>) and I'll probably have
-some recommendations.
-
-For reasons of concision and energetic laziness, some methods and
-options in this module (and the dozen modules it depends on) are
-undocumented; but one of those undocumented bits might be just what
-you're looking for.
-
-
-=head1 COPYRIGHT AND DISCLAIMERS
-
-Copyright (c) 2002-4 Sean M. Burke. All rights reserved.
-
-This library 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.
-
-=head1 AUTHOR
-
-Sean M. Burke C<sburke@cpan.org>
-
-=cut
-
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Probe/Perl.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Probe/Perl.pm
deleted file mode 100644
index c2b5e194185..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Probe/Perl.pm
+++ /dev/null
@@ -1,272 +0,0 @@
-package Probe::Perl;
-
-use vars qw( $VERSION );
-$VERSION = '0.01';
-
-use strict;
-
-# TODO: cache values derived from launching an external perl process
-# TODO: docs refer to Config.pm and $self->{config}
-
-
-use Config;
-use File::Spec;
-
-sub new {
- my $class = shift;
- my $data = shift || {};
- return bless( $data, $class );
-}
-
-sub config {
- my ($self, $key) = (shift, shift);
- if (@_) {
- unless (ref $self) {
- die "Can't set config values via $self->config(). Use $self->new() to create a local view";
- }
- $self->{$key} = shift;
- }
- return ref($self) && exists $self->{$key} ? $self->{$key} : $Config{$key};
-}
-
-sub config_revert {
- my $self = shift;
- die "Can't use config_revert() as a class method" unless ref($self);
-
- delete $self->{$_} foreach @_;
-}
-
-sub perl_version {
- my $self = shift;
- # Check the current perl interpreter
- # It's much more convenient to use $] here than $^V, but 'man
- # perlvar' says I'm not supposed to. Bloody tyrant.
- return $^V ? $self->perl_version_to_float(sprintf( "%vd", $^V )) : $];
-}
-
-sub perl_version_to_float {
- my ($self, $version) = @_;
- $version =~ s/\./../; # Double up the first dot so the output has one dot remaining
- $version =~ s/\.(\d+)/sprintf( '%03d', $1 )/eg;
- return $version;
-}
-
-sub perl_is_same {
- my ($self, $perl) = @_;
- return `$perl -MConfig=myconfig -e print -e myconfig` eq Config->myconfig;
-}
-
-sub find_perl_interpreter {
- my $self = shift;
-
- return $^X if File::Spec->file_name_is_absolute($^X);
-
- my $exe = $self->config('exe_ext');
-
- my $thisperl = $^X;
- if ($self->os_type eq 'VMS') {
- # VMS might have a file version at the end
- $thisperl .= $exe unless $thisperl =~ m/$exe(;\d+)?$/i;
- } elsif (defined $exe) {
- $thisperl .= $exe unless $thisperl =~ m/$exe$/i;
- }
-
- foreach my $perl ( $self->config('perlpath'),
- map( File::Spec->catfile($_, $thisperl),
- File::Spec->path() )
- ) {
- return $perl if -f $perl and $self->perl_is_same($perl);
- }
- return;
-}
-
-# Determine the default @INC for this Perl
-sub perl_inc {
- my $self = shift;
-
- local $ENV{PERL5LIB}; # this is not considered part of the default.
-
- my $perl = $self->find_perl_interpreter();
-
- my @inc = `$perl -l -e print -e for -e \@INC`;
- chomp @inc;
-
- return @inc;
-}
-
-
-{
- my %OSTYPES = qw(
- aix Unix
- bsdos Unix
- dgux Unix
- dynixptx Unix
- freebsd Unix
- linux Unix
- hpux Unix
- irix Unix
- darwin Unix
- machten Unix
- next Unix
- openbsd Unix
- netbsd Unix
- dec_osf Unix
- svr4 Unix
- svr5 Unix
- sco_sv Unix
- unicos Unix
- unicosmk Unix
- solaris Unix
- sunos Unix
- cygwin Unix
- os2 Unix
-
- dos Windows
- MSWin32 Windows
-
- os390 EBCDIC
- os400 EBCDIC
- posix-bc EBCDIC
- vmesa EBCDIC
-
- MacOS MacOS
- VMS VMS
- VOS VOS
- riscos RiscOS
- amigaos Amiga
- mpeix MPEiX
- );
-
-
- sub os_type {
- my $class = shift;
- return $OSTYPES{shift || $^O};
- }
-}
-
-
-1;
-
-__END__
-
-
-=head1 NAME
-
-Probe::Perl - Information about the currently running perl
-
-=head1 SYNOPSIS
-
- use Probe::Perl;
- $p = Probe::Perl->new();
-
- # Version of this perl as a floating point number
- $ver = $p->perl_version();
- $ver = Probe::Perl->perl_version();
-
- # Convert a multi-dotted string to a floating point number
- $ver = $p->perl_version_to_float($ver);
- $ver = Probe::Perl->perl_version_to_float($ver);
-
- # Check if the given perl is the same as the one currently running
- $bool = $p->perl_is_same($perl_path);
- $bool = Probe::Perl->perl_is_same($perl_path);
-
- # Find a path to the currently-running perl
- $path = $p->find_perl_interpreter();
- $path = Probe::Perl->find_perl_interpreter();
-
- # Get @INC before run-time additions
- @paths = $p->perl_inc();
- @paths = Probe::Perl->perl_inc();
-
- # Get the general type of operating system
- $type = $p->os_type();
- $type = Probe::Perl->os_type();
-
- # Access Config.pm values
- $val = $p->config('foo');
- $val = Probe::Perl->config('foo');
- $p->config('foo' => 'bar'); # Set locally
- $p->config_revert('foo'); # Revert
-
-=head1 DESCRIPTION
-
-This module provides methods for obtaining information about the
-currently running perl interpreter. It originally began life as code
-in the C<Module::Build> project, but has been externalized here for
-general use.
-
-=head1 METHODS
-
-=over 4
-
-=item new()
-
-Creates a new Probe::Perl object and returns it. Most methods in
-the Probe::Perl packages are available as class methods, so you
-don't always need to create a new object. But if you want to create a
-mutable view of the C<Config.pm> data, it's necessary to create an
-object to store the values in.
-
-=item config( $key [, $value] )
-
-Returns the C<Config.pm> value associated with C<$key>. If C<$value>
-is also specified, then the value is set to C<$value> for this view of
-the data. In this case, C<config()> must be called as an object
-method, not a class method.
-
-=item config_revert( $key )
-
-Removes any user-assigned value in this view of the C<Config.pm> data.
-
-=item find_perl_interpreter( )
-
-Returns the absolute path of this perl interpreter. This is actually
-sort of a tricky thing to discover sometimes - in these cases we use
-C<perl_is_same()> to verify.
-
-=item perl_version( )
-
-Returns the version of this perl interpreter as a perl-styled version
-number using C<perl_version_to_float()>. Uses C<$^V> if your perl is
-recent enough, otherwise uses C<$]>.
-
-=item perl_version_to_float( $version )
-
-Formats C<$version> as a perl-styled version number like C<5.008001>.
-
-=item perl_is_same( $perl )
-
-Given the name of a perl interpreter, this method determines if it has
-the same configuration as the one represented by the current perl
-instance. Usually this means it's exactly the same
-
-=item perl_inc( )
-
-Returns a list of directories in this perl's C<@INC> path, I<before>
-any entries from C<use lib>, C<$ENV{PERL5LIB}>, or C<-I> switches are
-added.
-
-=item os_type( [$osname] )
-
-Returns a generic OS type (e.g. "Unix", "Windows", "MacOS") for the
-given OS name. If no OS name is given it uses the value in $^O, which
-is the same as $Config{osname}.
-
-=back
-
-=head1 AUTHOR
-
-Randy W. Sims <randys@thepierianspring.org>
-
-Based partly on code from the Module::Build project, by Ken Williams
-<kwilliams@cpan.org> and others.
-
-=head1 COPYRIGHT
-
-Copyright 2005 Ken Williams and Randy Sims. 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/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Tee.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Tee.pm
deleted file mode 100644
index 2078308a387..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Tee.pm
+++ /dev/null
@@ -1,187 +0,0 @@
-package Tee;
-
-$VERSION = "0.13";
-@ISA = qw (Exporter);
-@EXPORT = qw (tee);
-
-use strict;
-use Exporter ();
-use File::Spec;
-use Probe::Perl;
-# use warnings; # only for Perl >= 5.6
-
-use constant PTEE => "ptee";
-
-#--------------------------------------------------------------------------#
-# Platform independent ptee invocation
-#--------------------------------------------------------------------------#
-
-my $p = Probe::Perl->new;
-my $perl = $p->find_perl_interpreter;
-my $ptee_cmd;
-my $to_devnull = " > " . File::Spec->devnull . " 2>&1";
-
-# On installation, we store a copy of ptee in auto/Tee so we're sure
-# to find it later without worrying about $ENV{PATH}
-
-for my $path ( @INC ) {
- my $try_ptee = File::Spec->catfile( $path, 'auto', 'Tee', PTEE );
- next unless -r $try_ptee;
- if ( $try_ptee =~ /\s/ ) {
- # protect with quotes
- $try_ptee =~ s{(.*)}{"$1"}ms;
- }
- if ( system("$try_ptee -V $to_devnull" ) == 0 ) {
- $ptee_cmd = $try_ptee;
- last;
- }
- if ( system("$perl $try_ptee -V $to_devnull") == 0 ) {
- $ptee_cmd = "$perl $try_ptee";
- last;
- }
-}
-
-#--------------------------------------------------------------------------#
-# Functions
-#--------------------------------------------------------------------------#
-
-sub tee {
- die "Couldn't find a working " . PTEE . "\n" unless $ptee_cmd;
- my $command = shift;
- my $options;
- $options = shift if (ref $_[0] eq 'HASH');
- my $files = join(" ", @_);
- my $redirect = $options->{stderr} ? " 2>&1 " : q{};
- my $append = $options->{append} ? " -a " : q{};
- system( "$command $redirect | $ptee_cmd $append $files" );
-}
-
-1; # modules must be true
-
-__END__
-#--------------------------------------------------------------------------#
-# main pod documentation
-#--------------------------------------------------------------------------#
-
-=begin wikidoc
-
-= NAME
-
-Tee - Pure Perl emulation of GNU tee
-
-= VERSION
-
-This documentation refers to version %%VERSION%%
-
-= SYNOPSIS
-
- # from Perl
- use Tee;
- tee( $command, @files );
-
- # from the command line
- $ cat README.txt | ptee COPY.txt
-
-= DESCRIPTION
-
-The {Tee} distribution provides the [ptee] program, a pure Perl emulation of
-the standard GNU tool {tee}. It is designed to be a platform-independent
-replacement for operating systems without a native {tee} program. As with
-{tee}, it passes input received on STDIN through to STDOUT while also writing a
-copy of the input to one or more files. By default, files will be overwritten.
-
-Unlike {tee}, {ptee} does not support ignoring interrupts, as signal handling
-is not sufficiently portable.
-
-The {Tee} module provides a convenience function that may be used in place of
-{system()} to redirect commands through {ptee}.
-
-= USAGE
-
-== {tee()}
-
- tee( $command, @filenames );
- tee( $command, \%options, @filenames );
-
-Executes the given command via {system()}, but pipes it through [ptee] to copy
-output to the list of files. Unlike with {system()}, the command must be a
-string as the command shell is used for redirection and piping. The return
-value of {system()} is passed through, but reflects the success of
-the {ptee} command, which isn't very useful.
-
-The second argument may be a hash-reference of options. Recognized options
-include:
-
-* stderr -- redirects STDERR to STDOUT before piping to [ptee] (default: false)
-* append -- passes the {-a} flag to [ptee] to append instead of overwriting
-(default: false)
-
-= LIMITATIONS
-
-Because of the way that {Tee} uses pipes, it is limited to capturing a single
-input stream, either STDOUT alone or both STDOUT and STDERR combined. A good,
-portable alternative for capturing these streams from a command separately is
-[IPC::Run3], though it does not allow passing it through to a terminal at the
-same time.
-
-= SEE ALSO
-
-* [ptee]
-* IPC::Run3
-* IO::Tee
-
-= BUGS
-
-Please report any bugs or feature using the CPAN Request Tracker.
-Bugs can be submitted by email to {bug-Tee@rt.cpan.org} or
-through the web interface at
-[http://rt.cpan.org/Public/Dist/Display.html?Name=Tee]
-
-When submitting a bug or request, please include a test-file or a patch to an
-existing test-file that illustrates the bug or desired feature.
-
-= AUTHOR
-
-David A. Golden (DAGOLDEN)
-
-dagolden@cpan.org
-
-http://www.dagolden.org/
-
-= COPYRIGHT AND LICENSE
-
-Copyright (c) 2006 by David A. Golden
-
-This program is free software; you can redistribute
-it and/or modify it under the same terms as Perl itself.
-
-The full text of the license can be found in the
-LICENSE file included with this module.
-
-
-= 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 LICENCE, 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.
-
-=end wikidoc
-
-=cut
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Tee.pod b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Tee.pod
deleted file mode 100644
index 8d239b45cf4..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Tee.pod
+++ /dev/null
@@ -1,142 +0,0 @@
-# Generated by Pod::WikiDoc version 0.15
-
-=pod
-
-=head1 NAME
-
-Tee - Pure Perl emulation of GNU tee
-
-=head1 VERSION
-
-This documentation refers to version 0.13
-
-=head1 SYNOPSIS
-
- # from Perl
- use Tee;
- tee( $command, @files );
-
- # from the command line
- $ cat README.txt | ptee COPY.txt
-
-=head1 DESCRIPTION
-
-The C<<< Tee >>> distribution provides the L<ptee> program, a pure Perl emulation of
-the standard GNU tool C<<< tee >>>. It is designed to be a platform-independent
-replacement for operating systems without a native C<<< tee >>> program. As with
-C<<< tee >>>, it passes input received on STDIN through to STDOUT while also writing a
-copy of the input to one or more files. By default, files will be overwritten.
-
-Unlike C<<< tee >>>, C<<< ptee >>> does not support ignoring interrupts, as signal handling
-is not sufficiently portable.
-
-The C<<< Tee >>> module provides a convenience function that may be used in place of
-C<<< system() >>> to redirect commands through C<<< ptee >>>.
-
-=head1 USAGE
-
-=head2 C<<< tee() >>>
-
- tee( $command, @filenames );
- tee( $command, \%options, @filenames );
-
-Executes the given command via C<<< system() >>>, but pipes it through L<ptee> to copy
-output to the list of files. Unlike with C<<< system() >>>, the command must be a
-string as the command shell is used for redirection and piping. The return
-value of C<<< system() >>> is passed through, but reflects the success of
-the C<<< ptee >>> command, which isn't very useful.
-
-The second argument may be a hash-reference of options. Recognized options
-include:
-
-=over
-
-=item *
-
-stderr -- redirects STDERR to STDOUT before piping to L<ptee> (default: false)
-
-=item *
-
-append -- passes the C<<< -a >>> flag to L<ptee> to append instead of overwriting
-(default: false)
-
-=back
-
-=head1 LIMITATIONS
-
-Because of the way that C<<< Tee >>> uses pipes, it is limited to capturing a single
-input stream, either STDOUT alone or both STDOUT and STDERR combined. A good,
-portable alternative for capturing these streams from a command separately is
-L<IPC::Run3>, though it does not allow passing it through to a terminal at the
-same time.
-
-=head1 SEE ALSO
-
-=over
-
-=item *
-
-L<ptee>
-
-=item *
-
-IPC::Run3
-
-=item *
-
-IO::Tee
-
-=back
-
-=head1 BUGS
-
-Please report any bugs or feature using the CPAN Request Tracker.
-Bugs can be submitted by email to C<<< bug-Tee@rt.cpan.org >>> or
-through the web interface at
-L<http://rt.cpan.org/Public/Dist/Display.html?Name=Tee>
-
-When submitting a bug or request, please include a test-file or a patch to an
-existing test-file that illustrates the bug or desired feature.
-
-=head1 AUTHOR
-
-David A. Golden (DAGOLDEN)
-
-dagolden@cpan.org
-
-http:E<sol>E<sol>www.dagolden.orgE<sol>
-
-=head1 COPYRIGHT AND LICENSE
-
-Copyright (c) 2006 by David A. Golden
-
-This program is free software; you can redistribute
-it andE<sol>or modify it under the same terms as Perl itself.
-
-The full text of the license can be found in the
-LICENSE file included with this module.
-
-=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 ANDE<sol>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 ANDE<sol>OR
-REDISTRIBUTE THE SOFTWARE AS PERMITTED BY THE ABOVE LICENCE, 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.
-
-
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Term/ReadLine/Perl.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Term/ReadLine/Perl.pm
deleted file mode 100644
index e5f727fddba..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Term/ReadLine/Perl.pm
+++ /dev/null
@@ -1,153 +0,0 @@
-package Term::ReadLine::Perl;
-use Carp;
-@ISA = qw(Term::ReadLine::Stub Term::ReadLine::Compa Term::ReadLine::Perl::AU);
-#require 'readline.pl';
-
-$VERSION = $VERSION = 1.0302;
-
-sub readline {
- shift;
- #my $in =
- &readline::readline(@_);
- #$loaded = defined &Term::ReadKey::ReadKey;
- #print STDOUT "\nrl=`$in', loaded = `$loaded'\n";
- #if (ref \$in eq 'GLOB') { # Bug under debugger
- # ($in = "$in") =~ s/^\*(\w+::)+//;
- #}
- #print STDOUT "rl=`$in'\n";
- #$in;
-}
-
-#sub addhistory {}
-*addhistory = \&AddHistory;
-
-#$term;
-$readline::minlength = 1; # To peacify -w
-$readline::rl_readline_name = undef; # To peacify -w
-$readline::rl_basic_word_break_characters = undef; # To peacify -w
-
-sub new {
- if (defined $term) {
- warn "Cannot create second readline interface, falling back to dumb.\n";
- return Term::ReadLine::Stub::new(@_);
- }
- shift; # Package
- if (@_) {
- if ($term) {
- warn "Ignoring name of second readline interface.\n" if defined $term;
- shift;
- } else {
- $readline::rl_readline_name = shift; # Name
- }
- }
- if (!@_) {
- if (!defined $term) {
- ($IN,$OUT) = Term::ReadLine->findConsole();
- # Old Term::ReadLine did not have a workaround for a bug in Win devdriver
- $IN = 'CONIN$' if $^O eq 'MSWin32' and "\U$IN" eq 'CON';
- open IN,
- # A workaround for another bug in Win device driver
- (($IN eq 'CONIN$' and $^O eq 'MSWin32') ? "+< $IN" : "< $IN")
- or croak "Cannot open $IN for read";
- open(OUT,">$OUT") || croak "Cannot open $OUT for write";
- $readline::term_IN = \*IN;
- $readline::term_OUT = \*OUT;
- }
- } else {
- if (defined $term and ($term->IN ne $_[0] or $term->OUT ne $_[1]) ) {
- croak "Request for a second readline interface with different terminal";
- }
- $readline::term_IN = shift;
- $readline::term_OUT = shift;
- }
- eval {require Term::ReadLine::readline}; die $@ if $@;
- # The following is here since it is mostly used for perl input:
- # $readline::rl_basic_word_break_characters .= '-:+/*,[])}';
- $term = bless [$readline::term_IN,$readline::term_OUT];
- unless ($ENV{PERL_RL} and $ENV{PERL_RL} =~ /\bo\w*=0/) {
- local $Term::ReadLine::termcap_nowarn = 1; # With newer Perls
- local $SIG{__WARN__} = sub {}; # With older Perls
- $term->ornaments(1);
- }
- return $term;
-}
-sub newTTY {
- my ($self, $in, $out) = @_;
- $readline::term_IN = $self->[0] = $in;
- $readline::term_OUT = $self->[1] = $out;
- my $sel = select($out);
- $| = 1; # for DB::OUT
- select($sel);
-}
-sub ReadLine {'Term::ReadLine::Perl'}
-sub MinLine {
- my $old = $readline::minlength;
- $readline::minlength = $_[1] if @_ == 2;
- return $old;
-}
-sub SetHistory {
- shift;
- @readline::rl_History = @_;
- $readline::rl_HistoryIndex = @readline::rl_History;
-}
-sub GetHistory {
- @readline::rl_History;
-}
-sub AddHistory {
- shift;
- push @readline::rl_History, @_;
- $readline::rl_HistoryIndex = @readline::rl_History + @_;
-}
-%features = (appname => 1, minline => 1, autohistory => 1, getHistory => 1,
- setHistory => 1, addHistory => 1, preput => 1,
- attribs => 1, 'newTTY' => 1,
- tkRunning => Term::ReadLine::Stub->Features->{'tkRunning'},
- ornaments => Term::ReadLine::Stub->Features->{'ornaments'},
- );
-sub Features { \%features; }
-# my %attribs;
-tie %attribs, 'Term::ReadLine::Perl::Tie' or die ;
-sub Attribs {
- \%attribs;
-}
-sub DESTROY {}
-
-package Term::ReadLine::Perl::AU;
-
-sub AUTOLOAD {
- { $AUTOLOAD =~ s/.*:://; } # preserve match data
- my $name = "readline::rl_$AUTOLOAD";
- die "Cannot do `$AUTOLOAD' in Term::ReadLine::Perl"
- unless exists $readline::{"rl_$AUTOLOAD"};
- *$AUTOLOAD = sub { shift; &$name };
- goto &$AUTOLOAD;
-}
-
-package Term::ReadLine::Perl::Tie;
-
-sub TIEHASH { bless {} }
-sub DESTROY {}
-
-sub STORE {
- my ($self, $name) = (shift, shift);
- $ {'readline::rl_' . $name} = shift;
-}
-sub FETCH {
- my ($self, $name) = (shift, shift);
- $ {'readline::rl_' . $name};
-}
-
-package Term::ReadLine::Compa;
-
-sub get_c {
- my $self = shift;
- getc($self->[0]);
-}
-
-sub get_line {
- my $self = shift;
- my $fh = $self->[0];
- scalar <$fh>;
-}
-
-1;
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Term/ReadLine/readline.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Term/ReadLine/readline.pm
deleted file mode 100644
index 9babb88321a..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Term/ReadLine/readline.pm
+++ /dev/null
@@ -1,4610 +0,0 @@
-##
-## Perl Readline -- The Quick Help
-## (see the manual for complete info)
-##
-## Once this package is included (require'd), you can then call
-## $text = &readline'readline($input);
-## to get lines of input from the user.
-##
-## Normally, it reads ~/.inputrc when loaded... to suppress this, set
-## $readline'rl_NoInitFromFile = 1;
-## before requiring the package.
-##
-## Call rl_bind to add your own key bindings, as in
-## &readline'rl_bind('C-L', 'possible-completions');
-##
-## Call rl_set to set mode variables yourself, as in
-## &readline'rl_set('TcshCompleteMode', 'On');
-##
-## To change the input mode (emacs or vi) use ~/.inputrc or call
-## &readline::rl_set('EditingMode', 'vi');
-## or &readline::rl_set('EditingMode', 'emacs');
-##
-## Call rl_basic_commands to set your own command completion, as in
-## &readline'rl_basic_commands('print', 'list', 'quit', 'run', 'status');
-##
-##
-
-# Wrap the code below (initially Perl4, now partially Perl4) into a fake
-# Perl5 pseudo-module; mismatch of package and file name is intentional
-# to make is harder to abuse this (very fragile) code...
-package readline;
-
-my $autoload_broken = 1; # currently: defined does not work with a-l
-my $useioctl = 1;
-my $usestty = 1;
-my $max_include_depth = 10; # follow $include's in init files this deep
-
-BEGIN { # Some old systems have ioctl "unsupported"
- *ioctl = sub ($$$) { eval { ioctl $_[0], $_[1], $_[2] } };
-}
-
-##
-## BLURB:
-## A pretty full-function package similar to GNU's readline.
-## Includes support for EUC-encoded Japanese text.
-##
-## Written by Jeffrey Friedl, Omron Corporation (jfriedl@omron.co.jp)
-##
-## Comments, corrections welcome.
-##
-## Thanks to the people at FSF for readline (and the code I referenced
-## while writing this), and for Roland Schemers whose line_edit.pl I used
-## as an early basis for this.
-##
-$VERSION = $VERSION = '1.0302';
-
-## - Changes from Slaven Rezic (slaven@rezic.de):
-## * reverted the usage of $ENV{EDITOR} to set startup mode
-## only ~/.inputrc or an explicit call to rl_set should
-## be used to set startup mode
-##
-# 1011109.011 - Changes from Russ Southern (russ@dvns.com):
-## * Added $rl_vi_replace_default_on_insert
-# 1000510.010 - Changes from Joe Petolino (petolino@eng.sun.com), requested
-## by Ilya:
-##
-## * Make it compatible with perl 5.003.
-## * Rename getc() to getc_with_pending().
-## * Change unshift(@Pending) to push(@Pending).
-##
-## 991109.009 - Changes from Joe Petolino (petolino@eng.sun.com):
-## Added vi mode. Also added a way to set the keymap default
-## action for multi-character keymaps, so that a 2-character
-## sequence (e.g. <esc>A) can be treated as two one-character
-## commands (<esc>, then A) if the sequence is not explicitly
-## mapped.
-##
-## Changed subs:
-##
-## * preinit(): Initialize new keymaps and other data structures.
-## Use $ENV{EDITOR} to set startup mode.
-##
-## * init(): Sets the global *KeyMap, since &F_ReReadInitFile
-## may have changed the key map.
-##
-## * InitKeymap(): $KeyMap{default} is now optional - don't
-## set it if $_[1] eq '';
-##
-## * actually_do_binding(): Set $KeyMap{default} for '\*' key;
-## warning if double-defined.
-##
-## * rl_bind(): Implement \* to set the keymap default. Also fix
-## some existing regex bugs that I happened to notice.
-##
-## * readline(): No longer takes input from $pending before
-## calling &$rl_getc(); instead, it calls getc_with_pending(),
-## which takes input from the new array @Pending
-## before calling &$rl_getc(). Sets the global
-## *KeyMap after do_command(), since do_command()
-## may change the keymap now. Does some cursor
-## manipulation after do_command() when at the end
-## of the line in vi command mode, to match the
-## behavior of vi.
-##
-## * rl_getc(): Added a my declaration for $key, which was
-## apparently omitted by the author. rl_getc() is
-## no longer called directly; instead, getc_with_pending() calls
-## it only after exhausting any requeued characters
-## in @Pending. @Pending is used to implement the
-## vi '.' command, as well as the emacs DoSearch
-## functionality.
-##
-## * do_command(): Now defaults the command to 'F_Ding' if
-## $KeyMap{default} is undefined. This is part
-## of the new \* feature.
-##
-## * savestate()/getstate(): Now use an anonymous array instead
-## of packing the fields into a string.
-##
-## * F_AcceptLine(): Code moved to new sub add_line_to_history(),
-## so that it may be called by F_SaveLine()
-## as well as by F_AcceptLine().
-##
-## * F_QuotedInsert(): Calls getc_with_pending() instead of &$rl_getc().
-##
-## * F_UnixWordRubout(): Fixed bug: changed 'my' declaration of
-## global $rl_basic_word_break_characters to 'local'.
-##
-## * DoSearch(): Calls getc_with_pending() instead of &$rl_getc(). Ungets
-## character onto @Pending instead of $pending.
-##
-## * F_EmacsEditingMode(): Resets global $Vi_mode;
-##
-## * F_ToggleEditingMode(): Deleted. We use F_ViInput() and
-## F_EmacsEditingMode() instead.
-##
-## * F_PrefixMeta(): Calls getc_with_pending() instead of &$rl_getc().
-##
-## * F_DigitArgument(): Calls getc_with_pending() instead of &$rl_getc().
-##
-## * F_Ding(): Returns undef, for testing by vi commands.
-##
-## * F_Complete(): Returns true if a completion was done, false
-## otherwise, so vi completion routines can test it.
-##
-## * complete_internal(): Returns true if a completion was done,
-## false otherwise, so vi completion routines can
-## test it. Does a little cursor massaging in vi
-## mode, to match the behavior of ksh vi mode.
-##
-## Disclaimer: the original code dates from the perl 4 days, and
-## isn't very pretty by today's standards (for example,
-## extensive use of typeglobs and localized globals). In the
-## interests of not breaking anything, I've tried to preserve
-## the old code as much as possible, and I've avoided making
-## major stylistic changes. Since I'm not a regular emacs user,
-## I haven't done much testing to see that all the emacs-mode
-## features still work.
-##
-## 940817.008 - Added $var_CompleteAddsuffix.
-## Now recognizes window-change signals (at least on BSD).
-## Various typos and bug fixes.
-## Changes from Chris Arthur (csa@halcyon.com):
-## Added a few new keybindings.
-## Various typos and bug fixes.
-## Support for use from a dumb terminal.
-## Pretty-printing of filename-completion matches.
-##
-## 930306.007 - Added rl_start_default_at_beginning.
-## Added optional message arg to &redisplay.
-## Added explicit numeric argument var to functions that use it.
-## Redid many commands to simplify.
-## Added TransposeChars, UpcaseWord, CapitalizeWord, DownCaseWord.
-## Redid key binding specs to better match GNU.. added
-## undocumented "new-style" bindings.... can now bind
-## arrow keys and other arbitrairly long key sequences.
-## Added if/else/then to .inputrc.
-##
-## 930305.006 - optional "default" added (from mmuegel@cssmp.corp.mot.com).
-##
-## 930211.005 - fixed strange problem with eval while keybinding
-##
-
-##
-## Ilya:
-##
-## Added support for ReadKey,
-##
-## Added customization variable $minlength
-## to denote minimal lenth of a string to be put into history buffer.
-##
-## Added support for a bug in debugger: preinit cannot be a subroutine ?!!!
-## (See immendiately below)
-##
-## Added support for WINCH hooks. The subroutine references should be put into
-## @winchhooks.
-##
-## Added F_ToggleInsertMode, F_HistorySearchBackward,
-## F_HistorySearchForward, PC keyboard bindings.
-## 0.93: Updates to Operate, couple of keybindings added.
-## $rl_completer_terminator_character, $rl_correct_sw added.
-## Reload-init-file moved to C-x C-x.
-## C-x ? and C-x * list/insert possible completions.
-
-$rl_getc = \&rl_getc;
-
-&preinit;
-&init;
-
-# # # # use strict 'vars';
-
-# # # # # Separation into my and vars needs some thought...
-
-# # # # use vars qw(@KeyMap %KeyMap $rl_screen_width $rl_start_default_at_beginning
-# # # # $rl_completion_function $rl_basic_word_break_characters
-# # # # $rl_completer_word_break_characters $rl_special_prefixes
-# # # # $rl_readline_name @rl_History $rl_MaxHistorySize
-# # # # $rl_max_numeric_arg $rl_OperateCount
-# # # # $KillBuffer $dumb_term $stdin_not_tty $InsertMode
-# # # # $rl_NoInitFromFile);
-
-# # # # my ($InputLocMsg, $term_OUT, $term_IN);
-# # # # my ($winsz_t, $TIOCGWINSZ, $winsz, $rl_margin, $hooj, $force_redraw);
-# # # # my ($hook, %var_HorizontalScrollMode, %var_EditingMode, %var_OutputMeta);
-# # # # my ($var_HorizontalScrollMode, $var_EditingMode, $var_OutputMeta);
-# # # # my (%var_ConvertMeta, $var_ConvertMeta, %var_MarkModifiedLines, $var_MarkModifiedLines);
-# # # # my ($term_readkey, $inDOS);
-# # # # my (%var_PreferVisibleBell, $var_PreferVisibleBell);
-# # # # my (%var_TcshCompleteMode, $var_TcshCompleteMode);
-# # # # my (%var_CompleteAddsuffix, $var_CompleteAddsuffix);
-# # # # my ($minlength, @winchhooks);
-# # # # my ($BRKINT, $ECHO, $FIONREAD, $ICANON, $ICRNL, $IGNBRK, $IGNCR, $INLCR,
-# # # # $ISIG, $ISTRIP, $NCCS, $OPOST, $RAW, $TCGETS, $TCOON, $TCSETS, $TCXONC,
-# # # # $TERMIOS_CFLAG, $TERMIOS_IFLAG, $TERMIOS_LFLAG, $TERMIOS_NORMAL_IOFF,
-# # # # $TERMIOS_NORMAL_ION, $TERMIOS_NORMAL_LOFF, $TERMIOS_NORMAL_LON,
-# # # # $TERMIOS_NORMAL_OOFF, $TERMIOS_NORMAL_OON, $TERMIOS_OFLAG,
-# # # # $TERMIOS_READLINE_IOFF, $TERMIOS_READLINE_ION, $TERMIOS_READLINE_LOFF,
-# # # # $TERMIOS_READLINE_LON, $TERMIOS_READLINE_OOFF, $TERMIOS_READLINE_OON,
-# # # # $TERMIOS_VMIN, $TERMIOS_VTIME, $TIOCGETP, $TIOCGWINSZ, $TIOCSETP,
-# # # # $fion, $fionread_t, $mode, $sgttyb_t,
-# # # # $termios, $termios_t, $winsz, $winsz_t);
-# # # # my ($line, $initialized, $term_readkey);
-
-
-# # # # # Global variables added for vi mode (I'm leaving them all commented
-# # # # # out, like the declarations above, until SelfLoader issues
-# # # # # are resolved).
-
-# # # # # True when we're in one of the vi modes.
-# # # # my $Vi_mode;
-
-# # # # # Array refs: saves keystrokes for '.' command. Undefined when we're
-# # # # # not doing a '.'-able command.
-# # # # my $Dot_buf; # Working buffer
-# # # # my $Last_vi_command; # Gets $Dot_buf when a command is parsed
-
-# # # # # These hold state for vi 'u' and 'U'.
-# # # # my($Dot_state, $Vi_undo_state, $Vi_undo_all_state);
-
-# # # # # Refs to hashes used for cursor movement
-# # # # my($Vi_delete_patterns, $Vi_move_patterns,
-# # # # $Vi_change_patterns, $Vi_yank_patterns);
-
-# # # # # Array ref: holds parameters from the last [fFtT] command, for ';'
-# # # # # and ','.
-# # # # my $Last_findchar;
-
-# # # # # Globals for history search commands (/, ?, n, N)
-# # # # my $Vi_search_re; # Regular expression (compiled by qr{})
-# # # # my $Vi_search_reverse; # True for '?' search, false for '/'
-
-
-##
-## What's Cool
-## ----------------------------------------------------------------------
-## * hey, it's in perl.
-## * Pretty full GNU readline like library...
-## * support for ~/.inputrc
-## * horizontal scrolling
-## * command/file completion
-## * rebinding
-## * history (with search)
-## * undo
-## * numeric prefixes
-## * supports multi-byte characters (at least for the Japanese I use).
-## * Has a tcsh-like completion-function mode.
-## call &readline'rl_set('tcsh-complete-mode', 'On') to turn on.
-##
-
-##
-## What's not Cool
-## ----------------------------------------------------------------------
-## Can you say HUGE?
-## I can't spell, so comments riddled with misspellings.
-## Written by someone that has never really used readline.
-## History mechanism is slightly different than GNU... may get fixed
-## someday, but I like it as it is now...
-## Killbuffer not a ring.. just one level.
-## Obviously not well tested yet.
-## Written by someone that doesn't have a bell on his terminal, so
-## proper readline use of the bell may not be here.
-##
-
-
-##
-## Functions beginning with F_ are functions that are mapped to keys.
-## Variables and functions beginning rl_ may be accessed/set/called/read
-## from outside the package. Other things are internal.
-##
-## Some notable internal-only variables of global proportions:
-## $prompt -- line prompt (passed from user)
-## $line -- the line being input
-## $D -- ``Dot'' -- index into $line of the cursor's location.
-## $InsertMode -- usually true. False means overwrite mode.
-## $InputLocMsg -- string for error messages, such as "[~/.inputrc line 2]"
-## *emacs_keymap -- keymap for emacs-mode bindings:
-## @emacs_keymap - bindings indexed by ASCII ordinal
-## $emacs_keymap{'name'} = "emacs_keymap"
-## $emacs_keymap{'default'} = "SelfInsert" (default binding)
-## *vi_keymap -- keymap for vi input mode bindings
-## *vicmd_keymap -- keymap for vi command mode bindings
-## *vipos_keymap -- keymap for vi positioning command bindings
-## *visearch_keymap -- keymap for vi search pattern input mode bindings
-## *KeyMap -- current keymap in effect.
-## $LastCommandKilledText -- needed so that subsequent kills accumulate
-## $lastcommand -- name of command previously run
-## $lastredisplay -- text placed upon screen during previous &redisplay
-## $si -- ``screen index''; index into $line of leftmost char &redisplay'ed
-## $force_redraw -- if set to true, causes &redisplay to be verbose.
-## $AcceptLine -- when set, its value is returned from &readline.
-## $ReturnEOF -- unless this also set, in which case undef is returned.
-## @Pending -- characters to be used as input.
-## @undo -- array holding all states of current line, for undoing.
-## $KillBuffer -- top of kill ring (well, don't have a kill ring yet)
-## @tcsh_complete_selections -- for tcsh mode, possible selections
-##
-## Some internal variables modified by &rl_set (see comment at &rl_set for
-## info about how these set'able variables work)
-## $var_EditingMode -- a keymap typeglob like *emacs_keymap or *vi_keymap
-## $var_TcshCompleteMode -- if true, the completion function works like
-## in tcsh. That is, the first time you try to complete something,
-## the common prefix is completed for you. Subsequent completion tries
-## (without other commands in between) cycles the command line through
-## the various possibilities. If/when you get the one you want, just
-## continue typing.
-## Other $var_ things not supported yet.
-##
-## Some variables used internally, but may be accessed from outside...
-## $VERSION -- just for good looks.
-## $rl_readline_name = name of program -- for .initrc if/endif stuff.
-## $rl_NoInitFromFile -- if defined when package is require'd, ~/.inputrc
-## will not be read.
-## @rl_History -- array of previous lines input
-## $rl_HistoryIndex -- history pointer (for moving about history array)
-## $rl_completion_function -- see "How Command Completion Works" (way) below.
-## $rl_basic_word_break_characters -- string of characters that can cause
-## a word break for forward-word, etc.
-## $rl_start_default_at_beginning --
-## Normally, the user's cursor starts at the end of any default text
-## passed to readline. If this variable is true, it starts at the
-## beginning.
-## $rl_completer_word_break_characters --
-## like $rl_basic_word_break_characters (and in fact defaults to it),
-## but for the completion function.
-## $rl_completer_terminator_character -- what to insert to separate
-## a completed token from the rest. Reset at beginning of
-## completion to ' ' so completion function can change it.
-## $rl_special_prefixes -- characters that are part of this string as well
-## as of $rl_completer_word_break_characters cause a word break for the
-## completer function, but remain part of the word. An example: consider
-## when the input might be perl code, and one wants to be able to
-## complete on variable and function names, yet still have the '$',
-## '&', '@',etc. part of the $text to be completed. Then set this var
-## to '&@$%' and make sure each of these characters is in
-## $rl_completer_word_break_characters as well....
-## $rl_MaxHistorySize -- maximum size that the history array may grow.
-## $rl_screen_width -- width readline thinks it can use on the screen.
-## $rl_correct_sw -- is substructed from the real width of the terminal
-## $rl_margin -- scroll by moving to within this far from a margin.
-## $rl_CLEAR -- what to output to clear the screen.
-## $rl_max_numeric_arg -- maximum numeric arg allowed.
-## $rl_vi_replace_default_on_insert
-## Normally, the text you enter is added to any default text passed to
-## readline. If this variable is true, default text will start out
-## highlighted (if supported by your terminal) and text entered while the
-## default is highlighted (during the _first_ insert mode only) will
-## replace the entire default line. Once you have left insert mode (hit
-## escape), everything works as normal.
-## - This is similar to many GUI controls' behavior, which select the
-## default text so that new text replaces the old.
-## - Use with $rl_start_default_at_beginning for normal-looking behavior
-## (though it works just fine without it).
-## Notes/Bugs:
-## - Control characters (like C-w) do not actually terminate this replace
-## mode, for the same reason it does not work in emacs mode.
-## - Spine-crawlingly scary subroutine redefinitions
-## $rl_mark - start of the region
-## $line_rl_mark - the line on which $rl_mark is active
-## $_rl_japanese_mb - For character movement suppose Japanese (which?!)
-## multi-byte encoding. (How to make a sane default?)
-##
-
-sub get_window_size
-{
- my $sig = shift;
- my ($num_cols,$num_rows);
-
- if (defined $term_readkey) {
- ($num_cols,$num_rows) = Term::ReadKey::GetTerminalSize($term_OUT);
- $rl_screen_width = $num_cols - $rl_correct_sw
- if defined($num_cols) && $num_cols;
- } elsif (defined $TIOCGWINSZ and &ioctl($term_IN,$TIOCGWINSZ,$winsz)) {
- ($num_rows,$num_cols) = unpack($winsz_t,$winsz);
- $rl_screen_width = $num_cols - $rl_correct_sw
- if defined($num_cols) && $num_cols;
- }
- $rl_margin = int($rl_screen_width/3);
- if (defined $sig) {
- $force_redraw = 1;
- &redisplay();
- }
-
- for $hook (@winchhooks) {
- eval {&$hook()}; warn $@ if $@ and $^W;
- }
- local $^W = 0; # WINCH may be illegal...
- $SIG{'WINCH'} = "readline::get_window_size";
-}
-
-# Fix: case-sensitivity of inputrc on/off keywords in
-# `set' commands. readline lib doesn't care about case.
-# changed case of keys 'On' and 'Off' to 'on' and 'off'
-# &rl_set changed so that it converts the value to
-# lower case before hash lookup.
-sub preinit
-{
- ## Set up the input and output handles
-
- $term_IN = \*STDIN unless defined $term_IN;
- $term_OUT = \*STDOUT unless defined $term_OUT;
- ## not yet supported... always on.
- $var_HorizontalScrollMode = 1;
- $var_HorizontalScrollMode{'On'} = 1;
- $var_HorizontalScrollMode{'Off'} = 0;
-
- $var_EditingMode{'emacs'} = *emacs_keymap;
- $var_EditingMode{'vi'} = *vi_keymap;
- $var_EditingMode{'vicmd'} = *vicmd_keymap;
- $var_EditingMode{'vipos'} = *vipos_keymap;
- $var_EditingMode{'visearch'} = *visearch_keymap;
-
- ## this is an addition. Very nice.
- $var_TcshCompleteMode = 0;
- $var_TcshCompleteMode{'On'} = 1;
- $var_TcshCompleteMode{'Off'} = 0;
-
- $var_CompleteAddsuffix = 1;
- $var_CompleteAddsuffix{'On'} = 1;
- $var_CompleteAddsuffix{'Off'} = 0;
-
- $var_DeleteSelection = $var_DeleteSelection{'On'} = 1;
- $var_DeleteSelection{'Off'} = 0;
- *rl_delete_selection = \$var_DeleteSelection; # Alias
-
- ## not yet supported... always on
- for ('InputMeta', 'OutputMeta') {
- ${"var_$_"} = 1;
- ${"var_$_"}{'Off'} = 0;
- ${"var_$_"}{'On'} = 1;
- }
-
- ## not yet supported... always off
- for ('ConvertMeta', 'MetaFlag', 'MarkModifiedLines', 'PreferVisibleBell',
- 'BlinkMatchingParen', 'VisibleStats', 'ShowAllIfAmbiguous',
- 'PrintCompletionsHorizontally', 'MarkDirectories', 'ExpandTilde',
- 'EnableKeypad', 'DisableCompletion', 'CompletionIgnoreCase') {
- ${"var_$_"} = 0;
- ${"var_$_"}{'Off'} = 0;
- ${"var_$_"}{'On'} = 1;
- }
-
- # To conform to interface
- $minlength = 1 unless defined $minlength;
-
- # WINCH hooks
- @winchhooks = ();
-
- $inDOS = $^O eq 'os2' || defined $ENV{OS2_SHELL} unless defined $inDOS;
- eval {
- require Term::ReadKey; $term_readkey++;
- } unless defined $ENV{PERL_RL_USE_TRK}
- and not $ENV{PERL_RL_USE_TRK};
- unless ($term_readkey) {
- eval {require "ioctl.pl"}; ## try to get, don't die if not found.
- eval {require "sys/ioctl.ph"}; ## try to get, don't die if not found.
- eval {require "sgtty.ph"}; ## try to get, don't die if not found.
- if ($inDOS and !defined $TIOCGWINSZ) {
- $TIOCGWINSZ=0;
- $TIOCGETP=1;
- $TIOCSETP=2;
- $sgttyb_t="I5 C8";
- $winsz_t="";
- $RAW=0xf002;
- $ECHO=0x0008;
- }
- $TIOCGETP = &TIOCGETP if defined(&TIOCGETP);
- $TIOCSETP = &TIOCSETP if defined(&TIOCSETP);
- $TIOCGWINSZ = &TIOCGWINSZ if defined(&TIOCGWINSZ);
- $FIONREAD = &FIONREAD if defined(&FIONREAD);
- $TCGETS = &TCGETS if defined(&TCGETS);
- $TCSETS = &TCSETS if defined(&TCSETS);
- $TCXONC = &TCXONC if defined(&TCXONC);
- $TIOCGETP = 0x40067408 if !defined($TIOCGETP);
- $TIOCSETP = 0x80067409 if !defined($TIOCSETP);
- $TIOCGWINSZ = 0x40087468 if !defined($TIOCGWINSZ);
- $FIONREAD = 0x4004667f if !defined($FIONREAD);
- $TCGETS = 0x40245408 if !defined($TCGETS);
- $TCSETS = 0x80245409 if !defined($TCSETS);
- $TCXONC = 0x20005406 if !defined($TCXONC);
-
- ## TTY modes
- $ECHO = &ECHO if defined(&ECHO);
- $RAW = &RAW if defined(&RAW);
- $RAW = 040 if !defined($RAW);
- $ECHO = 010 if !defined($ECHO);
- #$CBREAK = 002 if !defined($CBREAK);
- $mode = $RAW; ## could choose CBREAK for testing....
-
- $IGNBRK = 1 if !defined($IGNBRK);
- $BRKINT = 2 if !defined($BRKINT);
- $ISTRIP = 040 if !defined($ISTRIP);
- $INLCR = 0100 if !defined($INLCR);
- $IGNCR = 0200 if !defined($IGNCR);
- $ICRNL = 0400 if !defined($ICRNL);
- $OPOST = 1 if !defined($OPOST);
- $ISIG = 1 if !defined($ISIG);
- $ICANON = 2 if !defined($ICANON);
- $TCOON = 1 if !defined($TCOON);
- $TERMIOS_READLINE_ION = $BRKINT;
- $TERMIOS_READLINE_IOFF = $IGNBRK | $ISTRIP | $INLCR | $IGNCR | $ICRNL;
- $TERMIOS_READLINE_OON = 0;
- $TERMIOS_READLINE_OOFF = $OPOST;
- $TERMIOS_READLINE_LON = 0;
- $TERMIOS_READLINE_LOFF = $ISIG | $ICANON | $ECHO;
- $TERMIOS_NORMAL_ION = $BRKINT;
- $TERMIOS_NORMAL_IOFF = $IGNBRK;
- $TERMIOS_NORMAL_OON = $OPOST;
- $TERMIOS_NORMAL_OOFF = 0;
- $TERMIOS_NORMAL_LON = $ISIG | $ICANON | $ECHO;
- $TERMIOS_NORMAL_LOFF = 0;
-
- #$sgttyb_t = 'C4 S';
- #$winsz_t = "S S S S"; # rows,cols, xpixel, ypixel
- $sgttyb_t = 'C4 S' if !defined($sgttyb_t);
- $winsz_t = "S S S S" if !defined($winsz_t);
- # rows,cols, xpixel, ypixel
- $winsz = pack($winsz_t,0,0,0,0);
- $fionread_t = "L";
- $fion = pack($fionread_t, 0);
- $NCCS = 17;
- $termios_t = "LLLLc" . ("c" x $NCCS); # true for SunOS 4.1.3, at least...
- $termios = ''; ## just to shut up "perl -w".
- $termios = pack($termios, 0); # who cares, just make it long enough
- $TERMIOS_IFLAG = 0;
- $TERMIOS_OFLAG = 1;
- $TERMIOS_CFLAG = 2;
- $TERMIOS_LFLAG = 3;
- $TERMIOS_VMIN = 5 + 4;
- $TERMIOS_VTIME = 5 + 5;
- }
- $rl_delete_selection = 1;
- $rl_correct_sw = ($inDOS ? 1 : 0);
- $rl_scroll_nextline = 1 unless defined $rl_scroll_nextline;
- $rl_last_pos_can_backspace = ($inDOS ? 0 : 1) # Can backspace when the
- unless defined $rl_last_pos_can_backspace; # whole line is filled?
-
- $rl_start_default_at_beginning = 0;
- $rl_vi_replace_default_on_insert = 0;
- $rl_screen_width = 79; ## default
-
- $rl_completion_function = "rl_filename_list"
- unless defined($rl_completion_function);
- $rl_basic_word_break_characters = "\\\t\n' \"`\@\$><=;|&{(";
- $rl_completer_word_break_characters = $rl_basic_word_break_characters;
- $rl_special_prefixes = '';
- ($rl_readline_name = $0) =~ s#.*[/\\]## if !defined($rl_readline_name);
-
- @rl_History=() if !(@rl_History);
- $rl_MaxHistorySize = 100 if !defined($rl_MaxHistorySize);
- $rl_max_numeric_arg = 200 if !defined($rl_max_numeric_arg);
- $rl_OperateCount = 0 if !defined($rl_OperateCount);
-
- $rl_term_set = \@Term::ReadLine::TermCap::rl_term_set;
- @$rl_term_set or $rl_term_set = ["","","",""];
-
- $InsertMode=1;
- $KillBuffer='';
- $line='';
- $D = 0;
- $InputLocMsg = ' [initialization]';
-
- &InitKeymap(*emacs_keymap, 'SelfInsert', 'emacs_keymap',
- ($inDOS ? () : ('C-@', 'SetMark') ),
- 'C-a', 'BeginningOfLine',
- 'C-b', 'BackwardChar',
- 'C-c', 'Interrupt',
- 'C-d', 'DeleteChar',
- 'C-e', 'EndOfLine',
- 'C-f', 'ForwardChar',
- 'C-g', 'Abort',
- 'M-C-g', 'Abort',
- 'C-h', 'BackwardDeleteChar',
- "TAB" , 'Complete',
- "C-j" , 'AcceptLine',
- 'C-k', 'KillLine',
- 'C-l', 'ClearScreen',
- "C-m" , 'AcceptLine',
- 'C-n', 'NextHistory',
- 'C-o', 'OperateAndGetNext',
- 'C-p', 'PreviousHistory',
- 'C-q', 'QuotedInsert',
- 'C-r', 'ReverseSearchHistory',
- 'C-s', 'ForwardSearchHistory',
- 'C-t', 'TransposeChars',
- 'C-u', 'UnixLineDiscard',
- ##'C-v', 'QuotedInsert',
- 'C-v', 'HistorySearchForward',
- 'C-w', 'UnixWordRubout',
- qq/"\cX\cX"/, 'ExchangePointAndMark',
- qq/"\cX\cR"/, 'ReReadInitFile',
- qq/"\cX?"/, 'PossibleCompletions',
- qq/"\cX*"/, 'InsertPossibleCompletions',
- qq/"\cX\cU"/, 'Undo',
- qq/"\cXu"/, 'Undo',
- qq/"\cX\cW"/, 'KillRegion',
- qq/"\cXw"/, 'CopyRegionAsKill',
- qq/"\cX\ec\\*"/, 'DoControlVersion',
- qq/"\cX\ec\0"/, 'SetMark',
- qq/"\cX\ec\@"/, 'SetMark',
- qq/"\cX\ec "/, 'SetMark',
- qq/"\cX\em\\*"/, 'DoMetaVersion',
- qq/"\cX\@c\\*"/, 'DoControlVersion',
- qq/"\cX\@c\0"/, 'SetMark',
- qq/"\cX\@c\@"/, 'SetMark',
- qq/"\cX\@c "/, 'SetMark',
- qq/"\cX\@m\\*"/, 'DoMetaVersion',
- 'C-y', 'Yank',
- 'C-z', 'Suspend',
- 'C-\\', 'Ding',
- 'C-^', 'Ding',
- 'C-_', 'Undo',
- 'DEL', ($inDOS ?
- 'BackwardKillWord' : # <Control>+<Backspace>
- 'BackwardDeleteChar'
- ),
- 'M-<', 'BeginningOfHistory',
- 'M->', 'EndOfHistory',
- 'M-DEL', 'BackwardKillWord',
- 'M-C-h', 'BackwardKillWord',
- 'M-C-j', 'ViInput',
- 'M-C-v', 'QuotedInsert',
- 'M-b', 'BackwardWord',
- 'M-c', 'CapitalizeWord',
- 'M-d', 'KillWord',
- 'M-f', 'ForwardWord',
- 'M-h', 'PrintHistory',
- 'M-l', 'DownCaseWord',
- 'M-r', 'RevertLine',
- 'M-t', 'TransposeWords',
- 'M-u', 'UpcaseWord',
- 'M-v', 'HistorySearchBackward',
- 'M-y', 'YankPop',
- "M-?", 'PossibleCompletions',
- "M-TAB", 'TabInsert',
- 'M-#', 'SaveLine',
- qq/"\e[A"/, 'previous-history',
- qq/"\e[B"/, 'next-history',
- qq/"\e[C"/, 'forward-char',
- qq/"\e[D"/, 'backward-char',
- qq/"\eOA"/, 'previous-history',
- qq/"\eOB"/, 'next-history',
- qq/"\eOC"/, 'forward-char',
- qq/"\eOD"/, 'backward-char',
- qq/"\eOy"/, 'HistorySearchBackward', # vt: PageUp
- qq/"\eOs"/, 'HistorySearchForward', # vt: PageDown
- qq/"\e[[A"/, 'previous-history',
- qq/"\e[[B"/, 'next-history',
- qq/"\e[[C"/, 'forward-char',
- qq/"\e[[D"/, 'backward-char',
- qq/"\e[2~"/, 'ToggleInsertMode', # X: <Insert>
- # Mods: 1 + bitmask: 1 Shift, 2 Alt, 4 Control, 8 (sometimes) Meta
- qq/"\e[2;2~"/, 'YankClipboard', # <Shift>+<Insert>
- qq/"\e[3;2~"/, 'KillRegionClipboard', # <Shift>+<Delete>
- #qq/"\0\16"/, 'Undo', # <Alt>+<Backspace>
- qq/"\eO5D"/, 'BackwardWord', # <Ctrl>+<Left arrow>
- qq/"\eO5C"/, 'ForwardWord', # <Ctrl>+<Right arrow>
- qq/"\e[5D"/, 'BackwardWord', # <Ctrl>+<Left arrow>
- qq/"\e[5C"/, 'ForwardWord', # <Ctrl>+<Right arrow>
- qq/"\eO5F"/, 'KillLine', # <Ctrl>+<End>
- qq/"\e[5F"/, 'KillLine', # <Ctrl>+<End>
- qq/"\e[4;5~"/, 'KillLine', # <Ctrl>+<End>
- qq/"\eO5s"/, 'EndOfHistory', # <Ctrl>+<Page Down>
- qq/"\e[6;5~"/, 'EndOfHistory', # <Ctrl>+<Page Down>
- qq/"\e[5H"/, 'BackwardKillLine', # <Ctrl>+<Home>
- qq/"\eO5H"/, 'BackwardKillLine', # <Ctrl>+<Home>
- qq/"\e[1;5~"/, 'BackwardKillLine', # <Ctrl>+<Home>
- qq/"\eO5y"/, 'BeginningOfHistory', # <Ctrl>+<Page Up>
- qq/"\e[5;5y"/, 'BeginningOfHistory', # <Ctrl>+<Page Up>
- qq/"\e[2;5~"/, 'CopyRegionAsKillClipboard', # <Ctrl>+<Insert>
- qq/"\e[3;5~"/, 'KillWord', # <Ctrl>+<Delete>
-
- # XTerm mouse editing (f202/f203 not in mainstream yet):
- # Paste may be: move f200 STRING f201
- # or f202 move f200 STRING f201 f203;
- # and Cut may be f202 move delete f203
- qq/"\e[200~"/, 'BeginPasteGroup', # Pre-paste
- qq/"\e[201~"/, 'EndPasteGroup', # Post-paste
- qq/"\e[202~"/, 'BeginEditGroup', # Pre-edit
- qq/"\e[203~"/, 'EndEditGroup', # Post-edit
-
- # OSX xterm:
- # OSX xterm: home \eOH end \eOF delete \e[3~ help \e[28~ f13 \e[25~
- # gray- \eOm gray+ \eOk gray-enter \eOM gray* \eOj gray/ \eOo gray= \eO
- # grayClear \e\e.
-
- qq/"\eOH"/, 'BeginningOfLine', # home
- qq/"\eOF"/, 'EndOfLine', # end
-
- # HP xterm
- #qq/"\e[A"/, 'PreviousHistory', # up arrow
- #qq/"\e[B"/, 'NextHistory', # down arrow
- #qq/"\e[C"/, 'ForwardChar', # right arrow
- #qq/"\e[D"/, 'BackwardChar', # left arrow
- qq/"\e[H"/, 'BeginningOfLine', # home
- #'C-k', 'KillLine', # clear display
- qq/"\e[5~"/, 'HistorySearchBackward', # prev
- qq/"\e[6~"/, 'HistorySearchForward', # next
- qq/"\e[\0"/, 'BeginningOfLine', # home
-
- # These contradict:
- ($^O =~ /^hp\W?ux/i ? (
- qq/"\e[1~"/, 'HistorySearchForward', # find
- qq/"\e[3~"/, 'ToggleInsertMode', # insert char
- qq/"\e[4~"/, 'ToggleInsertMode', # select
- ) : ( # "Normal" xterm
- qq/"\e[1~"/, 'BeginningOfLine', # home
- qq/"\e[3~"/, 'DeleteChar', # delete
- qq/"\e[4~"/, 'EndOfLine', # end
- )),
-
- # hpterm
-
- (($ENV{'TERM'} and $ENV{'TERM'} eq 'hpterm') ?
- (
- qq/"\eA"/, 'PreviousHistory', # up arrow
- qq/"\eB"/, 'NextHistory', # down arrow
- qq/"\eC"/, 'ForwardChar', # right arrow
- qq/"\eD"/, 'BackwardChar', # left arrow
- qq/"\eS"/, 'BeginningOfHistory', # shift up arrow
- qq/"\eT"/, 'EndOfHistory', # shift down arrow
- qq/"\e&r1R"/, 'EndOfLine', # shift right arrow
- qq/"\e&r1L"/, 'BeginningOfLine', # shift left arrow
- qq/"\eJ"/, 'ClearScreen', # clear display
- qq/"\eM"/, 'UnixLineDiscard', # delete line
- qq/"\eK"/, 'KillLine', # clear line
- qq/"\eG\eK"/, 'BackwardKillLine', # shift clear line
- qq/"\eP"/, 'DeleteChar', # delete char
- qq/"\eL"/, 'Yank', # insert line
- qq/"\eQ"/, 'ToggleInsertMode', # insert char
- qq/"\eV"/, 'HistorySearchBackward',# prev
- qq/"\eU"/, 'HistorySearchForward',# next
- qq/"\eh"/, 'BeginningOfLine', # home
- qq/"\eF"/, 'EndOfLine', # shift home
- qq/"\ei"/, 'Suspend', # shift tab
- ) :
- ()
- ),
- ($inDOS ?
- (
- qq/"\0\2"/, 'SetMark', # 2: <Control>+<Space>
- qq/"\0\3"/, 'SetMark', # 3: <Control>+<@>
- qq/"\0\4"/, 'YankClipboard', # 4: <Shift>+<Insert>
- qq/"\0\5"/, 'KillRegionClipboard', # 5: <Shift>+<Delete>
- qq/"\0\16"/, 'Undo', # 14: <Alt>+<Backspace>
-# qq/"\0\23"/, 'RevertLine', # 19: <Alt>+<R>
-# qq/"\0\24"/, 'TransposeWords', # 20: <Alt>+<T>
-# qq/"\0\25"/, 'YankPop', # 21: <Alt>+<Y>
-# qq/"\0\26"/, 'UpcaseWord', # 22: <Alt>+<U>
-# qq/"\0\31"/, 'ReverseSearchHistory', # 25: <Alt>+<P>
-# qq/"\0\40"/, 'KillWord', # 32: <Alt>+<D>
-# qq/"\0\41"/, 'ForwardWord', # 33: <Alt>+<F>
-# qq/"\0\46"/, 'DownCaseWord', # 38: <Alt>+<L>
- #qq/"\0\51"/, 'TildeExpand', # 41: <Alt>+<\'>
-# qq/"\0\56"/, 'CapitalizeWord', # 46: <Alt>+<C>
-# qq/"\0\60"/, 'BackwardWord', # 48: <Alt>+<B>
-# qq/"\0\61"/, 'ForwardSearchHistory', # 49: <Alt>+<N>
- #qq/"\0\64"/, 'YankLastArg', # 52: <Alt>+<.>
- qq/"\0\65"/, 'PossibleCompletions', # 53: <Alt>+</>
- qq/"\0\107"/, 'BeginningOfLine', # 71: <Home>
- qq/"\0\110"/, 'previous-history', # 72: <Up arrow>
- qq/"\0\111"/, 'HistorySearchBackward', # 73: <Page Up>
- qq/"\0\113"/, 'backward-char', # 75: <Left arrow>
- qq/"\0\115"/, 'forward-char', # 77: <Right arrow>
- qq/"\0\117"/, 'EndOfLine', # 79: <End>
- qq/"\0\120"/, 'next-history', # 80: <Down arrow>
- qq/"\0\121"/, 'HistorySearchForward', # 81: <Page Down>
- qq/"\0\122"/, 'ToggleInsertMode', # 82: <Insert>
- qq/"\0\123"/, 'DeleteChar', # 83: <Delete>
- qq/"\0\163"/, 'BackwardWord', # 115: <Ctrl>+<Left arrow>
- qq/"\0\164"/, 'ForwardWord', # 116: <Ctrl>+<Right arrow>
- qq/"\0\165"/, 'KillLine', # 117: <Ctrl>+<End>
- qq/"\0\166"/, 'EndOfHistory', # 118: <Ctrl>+<Page Down>
- qq/"\0\167"/, 'BackwardKillLine', # 119: <Ctrl>+<Home>
- qq/"\0\204"/, 'BeginningOfHistory', # 132: <Ctrl>+<Page Up>
- qq/"\0\x92"/, 'CopyRegionAsKillClipboard', # 146: <Ctrl>+<Insert>
- qq/"\0\223"/, 'KillWord', # 147: <Ctrl>+<Delete>
- qq/"\0#"/, 'PrintHistory', # Alt-H
- )
- : ( 'C-@', 'Ding')
- )
- );
-
- *KeyMap = *emacs_keymap;
- my @add_bindings = ();
- foreach ('-', '0' .. '9') { push(@add_bindings, "M-$_", 'DigitArgument'); }
- foreach ("A" .. "Z") {
- next if # defined($KeyMap[27]) && defined (%{"$KeyMap{name}_27"}) &&
- defined $ {"$KeyMap{name}_27"}[ord $_];
- push(@add_bindings, "M-$_", 'DoLowercaseVersion');
- }
- if ($inDOS) {
- # Default translation of Alt-char
- $ {"$KeyMap{name}_0"}{'Esc'} = *{"$KeyMap{name}_27"};
- $ {"$KeyMap{name}_0"}{'default'} = 'F_DoEscVersion';
- }
- &rl_bind(@add_bindings);
-
- # Vi input mode.
- &InitKeymap(*vi_keymap, 'SelfInsert', 'vi_keymap',
-
- "\e", 'ViEndInsert',
- 'C-c', 'Interrupt',
- 'C-h', 'BackwardDeleteChar',
- 'C-w', 'UnixWordRubout',
- 'C-u', 'UnixLineDiscard',
- 'C-v', 'QuotedInsert',
- 'DEL', 'BackwardDeleteChar',
- "\n", 'ViAcceptInsert',
- "\r", 'ViAcceptInsert',
- );
-
- # Vi command mode.
- &InitKeymap(*vicmd_keymap, 'Ding', 'vicmd_keymap',
-
- 'C-c', 'Interrupt',
- 'C-e', 'EmacsEditingMode',
- 'C-h', 'ViMoveCursor',
- 'C-l', 'ClearScreen',
- "\n", 'ViAcceptLine',
- "\r", 'ViAcceptLine',
-
- ' ', 'ViMoveCursor',
- '#', 'SaveLine',
- '$', 'ViMoveCursor',
- '%', 'ViMoveCursor',
- '*', 'ViInsertPossibleCompletions',
- '+', 'NextHistory',
- ',', 'ViMoveCursor',
- '-', 'PreviousHistory',
- '.', 'ViRepeatLastCommand',
- '/', 'ViSearch',
-
- '0', 'ViMoveCursor',
- '1', 'ViDigit',
- '2', 'ViDigit',
- '3', 'ViDigit',
- '4', 'ViDigit',
- '5', 'ViDigit',
- '6', 'ViDigit',
- '7', 'ViDigit',
- '8', 'ViDigit',
- '9', 'ViDigit',
-
- ';', 'ViMoveCursor',
- '=', 'ViPossibleCompletions',
- '?', 'ViSearch',
-
- 'A', 'ViAppendLine',
- 'B', 'ViMoveCursor',
- 'C', 'ViChangeLine',
- 'D', 'ViDeleteLine',
- 'E', 'ViMoveCursor',
- 'F', 'ViMoveCursor',
- 'G', 'ViHistoryLine',
- 'H', 'PrintHistory',
- 'I', 'ViBeginInput',
- 'N', 'ViRepeatSearch',
- 'P', 'ViPutBefore',
- 'R', 'ViReplaceMode',
- 'S', 'ViChangeEntireLine',
- 'T', 'ViMoveCursor',
- 'U', 'ViUndoAll',
- 'W', 'ViMoveCursor',
- 'X', 'ViBackwardDeleteChar',
- 'Y', 'ViYankLine',
-
- '\\', 'ViComplete',
- '^', 'ViMoveCursor',
-
- 'a', 'ViAppend',
- 'b', 'ViMoveCursor',
- 'c', 'ViChange',
- 'd', 'ViDelete',
- 'e', 'ViMoveCursor',
- 'f', 'ViMoveCursorFind',
- 'h', 'ViMoveCursor',
- 'i', 'ViInput',
- 'j', 'NextHistory',
- 'k', 'PreviousHistory',
- 'l', 'ViMoveCursor',
- 'n', 'ViRepeatSearch',
- 'p', 'ViPut',
- 'r', 'ViReplaceChar',
- 's', 'ViChangeChar',
- 't', 'ViMoveCursorTo',
- 'u', 'ViUndo',
- 'w', 'ViMoveCursor',
- 'x', 'ViDeleteChar',
- 'y', 'ViYank',
-
- '|', 'ViMoveCursor',
- '~', 'ViToggleCase',
-
- (($inDOS
- and (not $ENV{'TERM'} or $ENV{'TERM'} !~ /^(vt|xterm)/i)) ?
- (
- qq/"\0\110"/, 'PreviousHistory', # 72: <Up arrow>
- qq/"\0\120"/, 'NextHistory', # 80: <Down arrow>
- qq/"\0\113"/, 'BackwardChar', # 75: <Left arrow>
- qq/"\0\115"/, 'ForwardChar', # 77: <Right arrow>
- "\e", 'ViCommandMode',
- ) :
-
- (('M-C-j','EmacsEditingMode'), # Conflicts with \e otherwise
- (($ENV{'TERM'} and $ENV{'TERM'} eq 'hpterm') ?
- (
- qq/"\eA"/, 'PreviousHistory', # up arrow
- qq/"\eB"/, 'NextHistory', # down arrow
- qq/"\eC"/, 'ForwardChar', # right arrow
- qq/"\eD"/, 'BackwardChar', # left arrow
- qq/"\e\\*"/, 'ViAfterEsc',
- ) :
-
- # Default
- (
- qq/"\e[A"/, 'PreviousHistory', # up arrow
- qq/"\e[B"/, 'NextHistory', # down arrow
- qq/"\e[C"/, 'ForwardChar', # right arrow
- qq/"\e[D"/, 'BackwardChar', # left arrow
- qq/"\e\\*"/, 'ViAfterEsc',
- qq/"\e[\\*"/, 'ViAfterEsc',
- )
- ))),
- );
-
- # Vi positioning commands (suffixed to vi commands like 'd').
- &InitKeymap(*vipos_keymap, 'ViNonPosition', 'vipos_keymap',
-
- '^', 'ViFirstWord',
- '0', 'BeginningOfLine',
- '1', 'ViDigit',
- '2', 'ViDigit',
- '3', 'ViDigit',
- '4', 'ViDigit',
- '5', 'ViDigit',
- '6', 'ViDigit',
- '7', 'ViDigit',
- '8', 'ViDigit',
- '9', 'ViDigit',
- '$', 'EndOfLine',
- 'h', 'BackwardChar',
- 'l', 'ForwardChar',
- ' ', 'ForwardChar',
- 'C-h', 'BackwardChar',
- 'f', 'ViForwardFindChar',
- 'F', 'ViBackwardFindChar',
- 't', 'ViForwardToChar',
- 'T', 'ViBackwardToChar',
- ';', 'ViRepeatFindChar',
- ',', 'ViInverseRepeatFindChar',
- '%', 'ViFindMatchingParens',
- '|', 'ViMoveToColumn',
-
- # Arrow keys
- ($inDOS ?
- (
- qq/"\0\115"/, 'ForwardChar', # 77: <Right arrow>
- qq/"\0\113"/, 'BackwardChar', # 75: <Left arrow>
- "\e", 'ViPositionEsc',
- ) :
-
- ($ENV{'TERM'} and $ENV{'TERM'} eq 'hpterm') ?
- (
- qq/"\eC"/, 'ForwardChar', # right arrow
- qq/"\eD"/, 'BackwardChar', # left arrow
- qq/"\e\\*"/, 'ViPositionEsc',
- ) :
-
- # Default
- (
- qq/"\e[C"/, 'ForwardChar', # right arrow
- qq/"\e[D"/, 'BackwardChar', # left arrow
- qq/"\e\\*"/, 'ViPositionEsc',
- qq/"\e[\\*"/, 'ViPositionEsc',
- )
- ),
- );
-
- # Vi search string input mode for '/' and '?'.
- &InitKeymap(*visearch_keymap, 'SelfInsert', 'visearch_keymap',
-
- "\e", 'Ding',
- 'C-c', 'Interrupt',
- 'C-h', 'ViSearchBackwardDeleteChar',
- 'C-w', 'UnixWordRubout',
- 'C-u', 'UnixLineDiscard',
- 'C-v', 'QuotedInsert',
- 'DEL', 'ViSearchBackwardDeleteChar',
- "\n", 'ViEndSearch',
- "\r", 'ViEndSearch',
- );
-
- # These constant hashes hold the arguments to &forward_scan() or
- # &backward_scan() for vi positioning commands, which all
- # behave a little differently for delete, move, change, and yank.
- #
- # Note: I originally coded these as qr{}, but changed them to q{} for
- # compatibility with older perls at the expense of some performance.
- #
- # Note: Some of the more obscure key combinations behave slightly
- # differently in different vi implementation. This module matches
- # the behavior of /usr/ucb/vi, which is different from the
- # behavior of vim, nvi, and the ksh command line. One example is
- # the command '2de', when applied to the string ('^' represents the
- # cursor, not a character of the string):
- #
- # ^5.6 7...88888888
- #
- # With /usr/ucb/vi and with this module, the result is
- #
- # ^...88888888
- #
- # but with the other three vi implementations, the result is
- #
- # ^ 7...88888888
-
- $Vi_delete_patterns = {
- ord('w') => q{(?:\w+|[^\w\s]+|)\s*},
- ord('W') => q{\S*\s*},
- ord('b') => q{\w+\s*|[^\w\s]+\s*|^\s+},
- ord('B') => q{\S+\s*|^\s+},
- ord('e') => q{.\s*\w+|.\s*[^\w\s]+|.\s*$},
- ord('E') => q{.\s*\S+|.\s*$},
- };
-
- $Vi_move_patterns = {
- ord('w') => q{(?:\w+|[^\w\s]+|)\s*},
- ord('W') => q{\S*\s*},
- ord('b') => q{\w+\s*|[^\w\s]+\s*|^\s+},
- ord('B') => q{\S+\s*|^\s+},
- ord('e') => q{.\s*\w*(?=\w)|.\s*[^\w\s]*(?=[^\w\s])|.?\s*(?=\s$)},
- ord('E') => q{.\s*\S*(?=\S)|.?\s*(?=\s$)},
- };
-
- $Vi_change_patterns = {
- ord('w') => q{\w+|[^\w\s]+|\s},
- ord('W') => q{\S+|\s},
- ord('b') => q{\w+\s*|[^\w\s]+\s*|^\s+},
- ord('B') => q{\S+\s*|^\s+},
- ord('e') => q{.\s*\w+|.\s*[^\w\s]+|.\s*$},
- ord('E') => q{.\s*\S+|.\s*$},
- };
-
- $Vi_yank_patterns = {
- ord('w') => q{(?:\w+|[^\w\s]+|)\s*},
- ord('W') => q{\S*\s*},
- ord('b') => q{\w+\s*|[^\w\s]+\s*|^\s+},
- ord('B') => q{\S+\s*|^\s+},
- ord('e') => q{.\s*\w*(?=\w)|.\s*[^\w\s]*(?=[^\w\s])|.?\s*(?=\s$)},
- ord('E') => q{.\s*\S*(?=\S)|.?\s*(?=\s$)},
- };
-
- my $default_mode = 'emacs';
-
- *KeyMap = $var_EditingMode = $var_EditingMode{$default_mode};
-
-## my $name;
-## for $name ( keys %{'readline::'} ) {
-## # Create aliases accessible via tied interface
-## *{"rl_$1"} = \$ {"var_$1"} if $name =~ /$var_(.*)/;
-## }
-
- 1; # Returning a glob causes a bug in db5.001m
-}
-
-sub init
-{
- if ($ENV{'TERM'} and ($ENV{'TERM'} eq 'emacs' || $ENV{'TERM'} eq 'dumb')) {
- $dumb_term = 1;
- } elsif (! -c $term_IN && $term_IN eq \*STDIN) { # Believe if it is given
- $stdin_not_tty = 1;
- } else {
- &get_window_size;
- &F_ReReadInitFile if !defined($rl_NoInitFromFile);
- $InputLocMsg = '';
- *KeyMap = $var_EditingMode;
- }
-
- $initialized = 1;
-}
-
-
-##
-## InitKeymap(*keymap, 'default', 'name', bindings.....)
-##
-sub InitKeymap
-{
- local(*KeyMap) = shift(@_);
- my $default = shift(@_);
- my $name = $KeyMap{'name'} = shift(@_);
-
- # 'default' is now optional - if '', &do_command() defaults it to
- # 'F_Ding'. Meta-maps now don't set a default - this lets
- # us detect multiple '\*' default declarations. JP
- if ($default ne '') {
- my $func = $KeyMap{'default'} = "F_$default";
- ### Temporarily disabled
- die qq/Bad default function [$func] for keymap "$name"/
- if !$autoload_broken and !defined(&$func);
- }
-
- &rl_bind if @_ > 0; ## The rest of @_ gets passed silently.
-}
-
-##
-## Accepts an array as pairs ($keyspec, $function, [$keyspec, $function]...).
-## and maps the associated bindings to the current KeyMap.
-##
-## keyspec should be the name of key sequence in one of two forms:
-##
-## Old (GNU readline documented) form:
-## M-x to indicate Meta-x
-## C-x to indicate Ctrl-x
-## M-C-x to indicate Meta-Ctrl-x
-## x simple char x
-## where 'x' above can be a single character, or the special:
-## special means
-## -------- -----
-## space space ( )
-## spc space ( )
-## tab tab (\t)
-## del delete (0x7f)
-## rubout delete (0x7f)
-## newline newline (\n)
-## lfd newline (\n)
-## ret return (\r)
-## return return (\r)
-## escape escape (\e)
-## esc escape (\e)
-##
-## New form:
-## "chars" (note the required double-quotes)
-## where each char in the list represents a character in the sequence, except
-## for the special sequences:
-## \\C-x Ctrl-x
-## \\M-x Meta-x
-## \\M-C-x Meta-Ctrl-x
-## \\e escape.
-## \\x x (if not one of the above)
-##
-##
-## FUNCTION should be in the form 'BeginningOfLine' or 'beginning-of-line'.
-## It is an error for the function to not be known....
-##
-## As an example, the following lines in .inputrc will bind one's xterm
-## arrow keys:
-## "\e[[A": previous-history
-## "\e[[B": next-history
-## "\e[[C": forward-char
-## "\e[[D": backward-char
-##
-
-sub filler_Pending ($) {
- my $keys = shift;
- sub {
- my $c = shift;
- push @Pending, map chr, @$keys;
- return if not @$keys or $c == 1 or not defined(my $in = &getc_with_pending);
- # provide the numeric argument
- local(*KeyMap) = $var_EditingMode;
- $doingNumArg = 1; # Allow NumArg inside NumArg
- &do_command(*KeyMap, $c, ord $in);
- return;
- }
-}
-
-sub _unescape ($) {
- my($key, @keys) = shift;
- ## New-style bindings are enclosed in double-quotes.
- ## Characters are taken verbatim except the special cases:
- ## \C-x Control x (for any x)
- ## \M-x Meta x (for any x)
- ## \e Escape
- ## \* Set the keymap default (JP: added this)
- ## (must be the last character of the sequence)
- ##
- ## \x x (unless it fits the above pattern)
- ##
- ## Look for special case of "\C-\M-x", which should be treated
- ## like "\M-\C-x".
-
- while (length($key) > 0) {
-
- # JP: fixed regex bugs below: changed all 's#' to 's#^'
-
- if ($key =~ s#^\\C-\\M-(.)##) {
- push(@keys, ord("\e"), &ctrl(ord($1)));
- } elsif ($key =~ s#^\\(M-|e)##) {
- push(@keys, ord("\e"));
- } elsif ($key =~ s#^\\C-(.)##) {
- push(@keys, &ctrl(ord($1)));
- } elsif ($key =~ s#^\\x([0-9a-fA-F]{2})##) {
- push(@keys, eval('0x'.$1));
- } elsif ($key =~ s#^\\([0-7]{3})##) {
- push(@keys, eval('0'.$1));
- } elsif ($key =~ s#^\\\*$##) { # JP: added
- push(@keys, 'default');
- } elsif ($key =~ s#^\\([afnrtv])##) {
- push(@keys, ord(eval(qq("\\$1"))));
- } elsif ($key =~ s#^\\d##) {
- push(@keys, 4); # C-d
- } elsif ($key =~ s#^\\b##) {
- push(@keys, 0x7f); # Backspace
- } elsif ($key =~ s#^\\(.)##) {
- push(@keys, ord($1));
- } else {
- push(@keys, ord($key));
- substr($key,0,1) = '';
- }
- }
- @keys
-}
-
-sub RL_func ($) {
- my $name_or_macro = shift;
- if ($name_or_macro =~ /^"((?:\\.|[^\\\"])*)"|^'((?:\\.|[^\\\'])*)'/s) {
- filler_Pending [_unescape "$+"];
- } else {
- "F_$name_or_macro";
- }
-}
-
-sub actually_do_binding
-{
- ##
- ## actually_do_binding($function1, \@sequence1, ...)
- ##
- ## Actually inserts the binding for @sequence to $function into the
- ## current map. @sequence is an array of character ordinals.
- ##
- ## If @sequence is more than one element long, all but the last will
- ## cause meta maps to be created.
- ##
- ## $Function will have an implicit "F_" prepended to it.
- ##
- while (@_) {
- my $func = shift;
- my ($key, @keys) = @{shift()};
- $key += 0;
- local(*KeyMap) = *KeyMap;
- my $map;
- while (@keys) {
- if (defined($KeyMap[$key]) && ($KeyMap[$key] ne 'F_PrefixMeta')) {
- warn "Warning$InputLocMsg: ".
- "Re-binding char #$key from [$KeyMap[$key]] to meta for [@keys] => $func.\n" if $^W;
- }
- $KeyMap[$key] = 'F_PrefixMeta';
- $map = "$KeyMap{'name'}_$key";
- InitKeymap(*$map, '', $map) if !(%$map);
- *KeyMap = *$map;
- $key = shift @keys;
- #&actually_do_binding($func, \@keys);
- }
-
- my $name = $KeyMap{'name'};
- if ($key eq 'default') { # JP: added
- warn "Warning$InputLocMsg: ".
- " changing default action to $func in $name key map\n"
- if $^W && defined $KeyMap{'default'};
-
- $KeyMap{'default'} = RL_func $func;
- }
- else {
- if (defined($KeyMap[$key]) && $KeyMap[$key] eq 'F_PrefixMeta'
- && $func ne 'PrefixMeta')
- {
- warn "Warning$InputLocMsg: ".
- " Re-binding char #$key to non-meta ($func) in $name key map\n"
- if $^W;
- }
- $KeyMap[$key] = RL_func $func;
- }
- }
-}
-
-sub rl_bind
-{
- my (@keys, $key, $func, $ord, @arr);
-
- while (defined($key = shift(@_)) && defined($func = shift(@_)))
- {
- ##
- ## Change the function name from something like
- ## backward-kill-line
- ## to
- ## BackwardKillLine
- ## if not already there.
- ##
- unless ($func =~ /^[\"\']/) {
- $func = "\u$func";
- $func =~ s/-(.)/\u$1/g;
-
- # Temporary disabled
- if (!$autoload_broken and !defined($ {'readline::'}{"F_$func"})) {
- warn "Warning$InputLocMsg: bad bind function [$func]\n" if $^W;
- next;
- }
- }
-
- ## print "sequence [$key] func [$func]\n"; ##DEBUG
-
- @keys = ();
- ## See if it's a new-style binding.
- if ($key =~ m/"((?:\\.|[^\\])*)"/s) {
- @keys = _unescape "$1";
- } else {
- ## ol-dstyle binding... only one key (or Meta+key)
- my ($isctrl, $orig) = (0, $key);
- $isctrl = $key =~ s/\b(C|Control|CTRL)-//i;
- push(@keys, ord("\e")) if $key =~ s/\b(M|Meta)-//i; ## is meta?
- ## Isolate key part. This matches GNU's implementation.
- ## If the key is '-', be careful not to delete it!
- $key =~ s/.*-(.)/$1/;
- if ($key =~ /^(space|spc)$/i) { $key = ' '; }
- elsif ($key =~ /^(rubout|del)$/i) { $key = "\x7f"; }
- elsif ($key =~ /^tab$/i) { $key = "\t"; }
- elsif ($key =~ /^(return|ret)$/i) { $key = "\r"; }
- elsif ($key =~ /^(newline|lfd)$/i) { $key = "\n"; }
- elsif ($key =~ /^(escape|esc)$/i) { $key = "\e"; }
- elsif (length($key) > 1) {
- warn "Warning$InputLocMsg: strange binding [$orig]\n" if $^W;
- }
- $key = ord($key);
- $key = &ctrl($key) if $isctrl;
- push(@keys, $key);
- }
-
- #
- ## Now do the mapping of the sequence represented in @keys
- #
- # print "&actually_do_binding($func, @keys)\n"; ##DEBUG
- push @arr, $func, [@keys];
- #&actually_do_binding($func, \@keys);
- }
- &actually_do_binding(@arr);
-}
-
-sub read_an_init_file {
- my $file = shift;
- my $include_depth = shift;
- local *RC;
- $file =~ s/^~([\\\/])/$ENV{HOME}$1/ if not -f $file and exists $ENV{HOME};
- return unless open RC, "< $file";
- my (@action) = ('exec'); ## exec, skip, ignore (until appropriate endif)
- my (@level) = (); ## if, else
-
- local $/ = "\n";
- while (<RC>) {
- s/^\s+//;
- next if m/^\s*(#|$)/;
- $InputLocMsg = " [$file line $.]";
- if (/^\$if\s+(.*)/) {
- my($test) = $1;
- push(@level, 'if');
- if ($action[$#action] ne 'exec') {
- ## We're supposed to be skipping or ignoring this level,
- ## so for subsequent levels we really ignore completely.
- push(@action, 'ignore');
- } else {
- ## We're executing this IF... do the test.
- ## The test is either "term=xxxx", or just a string that
- ## we compare to $rl_readline_name;
- if ($test =~ /term=([a-z0-9]+)/) {
- $test = ($ENV{'TERM'} && $1 eq $ENV{'TERM'});
- } else {
- $test = $test =~ /^(perl|$rl_readline_name)\s*$/i;
- }
- push(@action, $test ? 'exec' : 'skip');
- }
- next;
- } elsif (/^\$endif\b/) {
- die qq/\rWarning$InputLocMsg: unmatched endif\n/ if @level == 0;
- pop(@level);
- pop(@action);
- next;
- } elsif (/^\$else\b/) {
- die qq/\rWarning$InputLocMsg: unmatched else\n/ if
- @level == 0 || $level[$#level] ne 'if';
- $level[$#level] = 'else'; ## an IF turns into an ELSE
- if ($action[$#action] eq 'skip') {
- $action[$#action] = 'exec'; ## if were SKIPing, now EXEC
- } else {
- $action[$#action] = 'ignore'; ## otherwise, just IGNORE.
- }
- next;
- } elsif (/^\$include\s+(\S+)/) {
- if ($include_depth > $max_include_depth) {
- warn "Deep recursion in \$include directives in $file.\n";
- } else {
- read_an_init_file($1, $include_depth + 1);
- }
- } elsif ($action[$#action] ne 'exec') {
- ## skipping this one....
- # readline permits trailing comments in inputrc
- # this seems to solve the warnings caused by trailing comments in the
- # default /etc/inputrc on Mandrake Linux boxes.
- } elsif (m/\s*set\s+(\S+)\s+(\S*)/) { # Allow trailing comment
- &rl_set($1, $2, $file);
- } elsif (m/^\s*(\S+):\s+("(?:\\.|[^\\\"])*"|'(\\.|[^\\\'])*')/) { # Allow trailing comment
- &rl_bind($1, $2);
- } elsif (m/^\s*(\S+):\s+(\S+)/) { # Allow trailing comment
- &rl_bind($1, $2);
- } else {
- chomp;
- warn "\rWarning$InputLocMsg: Bad line [$_]\n" if $^W;
- }
- }
- close(RC);
-}
-
-sub F_ReReadInitFile
-{
- my ($file) = $ENV{'TRP_INPUTRC'};
- $file = $ENV{'INPUTRC'} unless defined $file;
- unless (defined $file) {
- return unless defined $ENV{'HOME'};
- $file = "$ENV{'HOME'}/.inputrc";
- }
- read_an_init_file($file, 0);
-}
-
-sub get_ornaments_selected {
- return if @$rl_term_set >= 6;
- local $^W=0;
- my $Orig = $Term::ReadLine::Perl::term->ornaments();
- eval {
- # Term::ReadLine does not expose its $terminal, so make another
- require Term::Cap;
- my $terminal = Tgetent Term::Cap ({OSPEED=>9600});
- # and be sure the terminal supports highlighting
- $terminal->Trequire('mr');
- };
- if (!$@ and $Orig ne ',,,'){
- my @set = @$rl_term_set;
-
- $Term::ReadLine::Perl::term->ornaments
- (join(',', (split(/,/, $Orig))[0,1]) . ',mr,me') ;
- @set[4,5] = @$rl_term_set[2,3];
- $Term::ReadLine::Perl::term->ornaments($Orig);
- @$rl_term_set = @set;
- } else {
- @$rl_term_set[4,5] = @$rl_term_set[2,3];
- }
-}
-
-sub readline_dumb {
- local $\ = '';
- print $term_OUT $prompt;
- local $/ = "\n";
- return undef
- if !defined($line = $Term::ReadLine::Perl::term->get_line);
- chomp($line);
- $| = $oldbar;
- select $old;
- return $line;
-}
-
-##
-## This is it. Called as &readline'readline($prompt, $default),
-## (DEFAULT can be omitted) the next input line is returned (undef on EOF).
-##
-sub readline
-{
- $Term::ReadLine::Perl::term->register_Tk
- if not $Term::ReadLine::registered and $Term::ReadLine::toloop
- and defined &Tk::DoOneEvent;
- if ($stdin_not_tty) {
- local $/ = "\n";
- return undef if !defined($line = <$term_IN>);
- chomp($line);
- return $line;
- }
-
- $old = select $term_OUT;
- $oldbar = $|;
- local($|) = 1;
- local($input);
-
- ## prompt should be given to us....
- $prompt = defined($_[0]) ? $_[0] : 'INPUT> ';
-
- # Try to move cursor to the beginning of the next line if this line
- # contains anything.
-
- # On DOSish 80-wide console
- # perl -we "print 1 x shift, qq(\b2\r3); sleep 2" 79
- # prints 3 on the same line,
- # perl -we "print 1 x shift, qq(\b2\r3); sleep 2" 80
- # on the next; $rl_screen_width is 79.
-
- # on XTerm one needs to increase the number by 1.
-
- print $term_OUT ' ' x ($rl_screen_width - !$rl_last_pos_can_backspace) . "\b \r"
- if $rl_scroll_nextline;
-
- if ($dumb_term) {
- return readline_dumb;
- }
-
- # test if we resume an 'Operate' command
- if ($rl_OperateCount > 0 && (!defined $_[1] || $_[1] eq '')) {
- ## it's from a valid previous 'Operate' command and
- ## user didn't give a default line
- ## we leave $rl_HistoryIndex untouched
- $line = $rl_History[$rl_HistoryIndex];
- } else {
- ## set history pointer at the end of history
- $rl_HistoryIndex = $#rl_History + 1;
- $rl_OperateCount = 0;
- $line = defined $_[1] ? $_[1] : '';
- }
- $rl_OperateCount-- if $rl_OperateCount > 0;
-
- $line_for_revert = $line;
-
-# I don't think we need to do this, actually...
-# while (&ioctl(STDIN,$FIONREAD,$fion))
-# {
-# local($n_chars_available) = unpack ($fionread_t, $fion);
-# ## print "n_chars = $n_chars_available\n";
-# last if $n_chars_available == 0;
-# $line .= getc_with_pending; # should we prepend if $rl_start_default_at_beginning?
-# }
-
- $D = $rl_start_default_at_beginning ? 0 : length($line); ## set dot.
- $LastCommandKilledText = 0; ## heck, was no last command.
- $lastcommand = ''; ## Well, there you go.
- $line_rl_mark = -1;
-
- ##
- ## some stuff for &redisplay.
- ##
- $lastredisplay = ''; ## Was no last redisplay for this time.
- $lastlen = length($lastredisplay);
- $lastpromptlen = 0;
- $lastdelta = 0; ## Cursor was nowhere
- $si = 0; ## Want line to start left-justified
- $force_redraw = 1; ## Want to display with brute force.
- if (!eval {SetTTY()}) { ## Put into raw mode.
- warn $@ if $@;
- $dumb_term = 1;
- return readline_dumb;
- }
-
- *KeyMap = $var_EditingMode;
- undef($AcceptLine); ## When set, will return its value.
- undef($ReturnEOF); ## ...unless this on, then return undef.
- @Pending = (); ## Contains characters to use as input.
- @undo = (); ## Undo history starts empty for each line.
- @undoGroupS = (); ## Undo groups start empty for each line.
- undef $memorizedArg; ## No digitArgument memorized
- undef $memorizedPos; ## No position memorized
-
- undef $Vi_undo_state;
- undef $Vi_undo_all_state;
-
- # We need to do some additional initialization for vi mode.
- # RS: bug reports/platform issues are welcome: russ@dvns.com
- if ($KeyMap{'name'} eq 'vi_keymap'){
- &F_ViInput();
- if ($rl_vi_replace_default_on_insert){
- local $^W=0;
- my $Orig = $Term::ReadLine::Perl::term->ornaments();
- eval {
- # Term::ReadLine does not expose its $terminal, so make another
- require Term::Cap;
- my $terminal = Tgetent Term::Cap ({OSPEED=>9600});
- # and be sure the terminal supports highlighting
- $terminal->Trequire('mr');
- };
- if (!$@ and $Orig ne ',,,'){
- $Term::ReadLine::Perl::term->ornaments
- (join(',', (split(/,/, $Orig))[0,1]) . ',mr,me')
- }
- my $F_SelfInsert_Real = \&F_SelfInsert;
- *F_SelfInsert = sub {
- $Term::ReadLine::Perl::term->ornaments($Orig);
- &F_ViChangeEntireLine;
- local $^W=0;
- *F_SelfInsert = $F_SelfInsert_Real;
- &F_SelfInsert;
- };
- my $F_ViEndInsert_Real = \&F_ViEndInsert;
- *F_ViEndInsert = sub {
- $Term::ReadLine::Perl::term->ornaments($Orig);
- local $^W=0;
- *F_SelfInsert = $F_SelfInsert_Real;
- *F_ViEndInsert = $F_ViEndInsert_Real;
- &F_ViEndInsert;
- $force_redraw = 1;
- redisplay();
- };
- }
- }
-
- if ($rl_default_selected) {
- redisplay_high();
- } else {
- &redisplay(); ## Show the line (prompt+default at this point).
- }
-
- # pretend input if we 'Operate' on more than one line
- &F_OperateAndGetNext($rl_OperateCount) if $rl_OperateCount > 0;
-
- $rl_first_char = 1;
- while (!defined($AcceptLine)) {
- ## get a character of input
- $input = &getc_with_pending(); # bug in debugger, returns 42. - No more!
-
- unless (defined $input) {
- # XXX What to do??? Until this is clear, just pretend we got EOF
- $AcceptLine = $ReturnEOF = 1;
- last;
- }
- preserve_state();
-
- $ThisCommandKilledText = 0;
- ##print "\n\rline is @$D:[$line]\n\r"; ##DEBUG
- my $cmd = get_command($var_EditingMode, ord($input));
- if ( $rl_first_char && $cmd =~ /^F_(SelfInsert$|Yank)/
- && length $line && $rl_default_selected ) {
- # (Backward)?DeleteChar specialcased in the code
- $line = '';
- $D = 0;
- $cmd = 'F_BackwardDeleteChar' if $cmd eq 'F_DeleteChar';
- }
- undef $doingNumArg;
- &$cmd(1, ord($input)); ## actually execute input
- $rl_first_char = 0;
- $lastcommand = $cmd;
- *KeyMap = $var_EditingMode; # JP: added
-
- # In Vi command mode, don't position the cursor beyond the last
- # character of the line buffer.
- &F_BackwardChar(1) if $Vi_mode and $line ne ''
- and &at_end_of_line and $KeyMap{'name'} eq 'vicmd_keymap';
-
- &redisplay();
- $LastCommandKilledText = $ThisCommandKilledText;
- }
-
- undef @undo; ## Release the memory.
- undef @undoGroupS; ## Release the memory.
- &ResetTTY; ## Restore the tty state.
- $| = $oldbar;
- select $old;
- return undef if defined($ReturnEOF);
- #print STDOUT "|al=`$AcceptLine'";
- $AcceptLine; ## return the line accepted.
-}
-
-## ctrl(ord('a')) will return the ordinal for Ctrl-A.
-sub ctrl {
- $_[0] ^ (($_[0]>=ord('a') && $_[0]<=ord('z')) ? 0x60 : 0x40);
-}
-
-
-
-sub SetTTY {
- return if $dumb_term || $stdin_not_tty;
- #return system 'stty raw -echo' if defined &DB::DB;
- if (defined $term_readkey) {
- Term::ReadKey::ReadMode(4, $term_IN);
- if ($^O eq 'MSWin32') {
- # If we reached this, Perl isn't cygwin; Enter sends \r; thus we need binmode
- # XXXX Do we need to undo??? $term_IN is most probably private now...
- binmode $term_IN;
- }
- return 1;
- }
-# system 'stty raw -echo';
-
- $sgttyb = ''; ## just to quiet "perl -w";
- if ($useioctl && $^O ne 'solaris' && defined $TIOCGETP
- && &ioctl($term_IN,$TIOCGETP,$sgttyb)) {
- @tty_buf = unpack($sgttyb_t,$sgttyb);
- if (defined $ENV{OS2_SHELL}) {
- $tty_buf[3] &= ~$mode;
- $tty_buf[3] &= ~$ECHO;
- } else {
- $tty_buf[4] |= $mode;
- $tty_buf[4] &= ~$ECHO;
- }
- $sgttyb = pack($sgttyb_t,@tty_buf);
- &ioctl($term_IN,$TIOCSETP,$sgttyb) || die "Can't ioctl TIOCSETP: $!";
- } elsif (!$usestty) {
- return 0;
- } else {
- warn <<EOW if $useioctl and not defined $ENV{PERL_READLINE_NOWARN};
-Can't ioctl TIOCGETP: $!
-Consider installing Term::ReadKey from CPAN site nearby
- at http://www.perl.com/CPAN
-Or use
- perl -MCPAN -e shell
-to reach CPAN. Falling back to 'stty'.
- If you do not want to see this warning, set PERL_READLINE_NOWARN
-in your environment.
-EOW
- # '; # For Emacs.
- $useioctl = 0;
- system 'stty raw -echo' and ($usestty = 0, die "Cannot call `stty': $!");
- if ($^O eq 'MSWin32') {
- # If we reached this, Perl isn't cygwin, but STTY is present ==> cygwin
- # The symptoms: now Enter sends \r; thus we need binmode
- # XXXX Do we need to undo??? $term_IN is most probably private now...
- binmode $term_IN;
- }
- }
- return 1;
-}
-
-sub ResetTTY {
- return if $dumb_term || $stdin_not_tty;
- #return system 'stty -raw echo' if defined &DB::DB;
- if (defined $term_readkey) {
- return Term::ReadKey::ReadMode(0, $term_IN);
- }
-
-# system 'stty -raw echo';
- if ($useioctl) {
- &ioctl($term_IN,$TIOCGETP,$sgttyb) || die "Can't ioctl TIOCGETP: $!";
- @tty_buf = unpack($sgttyb_t,$sgttyb);
- if (defined $ENV{OS2_SHELL}) {
- $tty_buf[3] |= $mode;
- $tty_buf[3] |= $ECHO;
- } else {
- $tty_buf[4] &= ~$mode;
- $tty_buf[4] |= $ECHO;
- }
- $sgttyb = pack($sgttyb_t,@tty_buf);
- &ioctl($term_IN,$TIOCSETP,$sgttyb) || die "Can't ioctl TIOCSETP: $!";
- } elsif ($usestty) {
- system 'stty -raw echo' and die "Cannot call `stty': $!";
- }
-}
-
-# Substr_with_props: gives the substr of prompt+string with embedded
-# face-change commands
-
-sub substr_with_props {
- my ($p, $s, $from, $len, $ket, $bsel, $esel) = @_;
- my $lp = length $p;
-
- defined $from or $from = 0;
- defined $len or $len = length($p) + length($s) - $from;
- unless (defined $ket) {
- warn 'bug in Term::ReadLine::Perl, please report to its author cpan@ilyaz.org';
- $ket = '';
- }
- # We may draw over to put cursor in a correct position:
- $ket = '' if $len < length($p) + length($s) - $from; # Not redrawn
-
- if ($from >= $lp) {
- $p = '';
- $s = substr $s, $from - $lp;
- $lp = 0;
- } else {
- $p = substr $p, $from;
- $lp -= $from;
- $from = 0;
- }
- $s = substr $s, 0, $len - $lp;
- $p =~ s/^(\s*)//; my $bs = $1;
- $p =~ s/(\s*)$//; my $as = $1;
- $p = $rl_term_set->[0] . $p . $rl_term_set->[1] if length $p;
- $p = "$bs$p$as";
- $ket = chop $s if $ket;
- if (defined $bsel and $bsel != $esel) {
- $bsel = $len if $bsel > $len;
- $esel = $len if $esel > $len;
- }
- if (defined $bsel and $bsel != $esel) {
- get_ornaments_selected;
- $bsel -= $lp; $esel -= $lp;
- my ($pre, $sel, $post) =
- (substr($s, 0, $bsel),
- substr($s, $bsel, $esel-$bsel),
- substr($s, $esel));
- $pre = $rl_term_set->[2] . $pre . $rl_term_set->[3] if length $pre;
- $sel = $rl_term_set->[4] . $sel . $rl_term_set->[5] if length $sel;
- $post = $rl_term_set->[2] . $post . $rl_term_set->[3] if length $post;
- $s = "$pre$sel$post"
- } else {
- $s = $rl_term_set->[2] . $s . $rl_term_set->[3] if length $s;
- }
-
- if (!$lp) { # Should not happen...
- return $s;
- } elsif (!length $s) { # Should not happen
- return $p;
- } else { # Do not underline spaces in the prompt
- return "$p$s"
- . (length $ket ? ($rl_term_set->[0] . $ket . $rl_term_set->[1]) : '');
- }
-}
-
-sub redisplay_high {
- get_ornaments_selected();
- @$rl_term_set[2,3,4,5] = @$rl_term_set[4,5,2,3];
- &redisplay(); ## Show the line, default inverted.
- @$rl_term_set[2,3,4,5] = @$rl_term_set[4,5,2,3];
- $force_redraw = 1;
-}
-
-##
-## redisplay()
-##
-## Updates the screen to reflect the current $line.
-##
-## For the purposes of this routine, we prepend the prompt to a local copy of
-## $line so that we display the prompt as well. We then modify it to reflect
-## that some characters have different sizes (i.e. control-C is represented
-## as ^C, tabs are expanded, etc.)
-##
-## This routine is somewhat complicated by two-byte characters.... must
-## make sure never to try do display just half of one.
-##
-## NOTE: If an argument is given, it is used instead of the prompt.
-##
-## This is some nasty code.
-##
-sub redisplay
-{
- ## local $line has prompt also; take that into account with $D.
- local($prompt) = defined($_[0]) ? $_[0] : $prompt;
- my ($thislen, $have_bra);
- my($dline) = $prompt . $line;
- local($D) = $D + length($prompt);
- my ($bsel, $esel);
- if (defined pos $line) {
- $bsel = (pos $line) + length $prompt;
- }
- my ($have_ket) = '';
-
- ##
- ## If the line contains anything that might require special processing
- ## for displaying (such as tabs, control characters, etc.), we will
- ## take care of that now....
- ##
- if ($dline =~ m/[^\x20-\x7e]/)
- {
- local($new, $Dinc, $c) = ('', 0);
-
- ## Look at each character of $dline in turn.....
- for ($i = 0; $i < length($dline); $i++) {
- $c = substr($dline, $i, 1);
-
- ## A tab to expand...
- if ($c eq "\t") {
- $c = ' ' x (8 - (($i-length($prompt)) % 8));
-
- ## A control character....
- } elsif ($c =~ tr/\000-\037//) {
- $c = sprintf("^%c", ord($c)+ord('@'));
-
- ## the delete character....
- } elsif (ord($c) == 127) {
- $c = '^?';
- }
- $new .= $c;
-
- ## Bump over $D if this char is expanded and left of $D.
- $Dinc += length($c) - 1 if (length($c) > 1 && $i < $D);
- ## Bump over $bsel if this char is expanded and left of $bsel.
- $bsel += length($c) - 1 if (defined $bsel && length($c) > 1 && $i < $bsel);
- }
- $dline = $new;
- $D += $Dinc;
- }
-
- ##
- ## Now $dline is what we'd like to display.
- ##
- ## If it's too long to fit on the line, we must decide what we can fit.
- ##
- ## If we end up moving the screen index ($si) [index of the leftmost
- ## character on the screen], to some place other than the front of the
- ## the line, we'll have to make sure that it's not on the first byte of
- ## a 2-byte character, 'cause we'll be placing a '<' marker there, and
- ## that would screw up the 2-byte character.
- ##
- ## $si is preserved between several displays (if possible).
- ##
- ## Similarly, if the line needs chopped off, we make sure that the
- ## placement of the tailing '>' won't screw up any 2-byte character in
- ## the vicinity.
- ##
- if ($D == length($prompt)) {
- $si = 0; ## display from the beginning....
- } elsif ($si >= $D) { # point to the left
- $si = &max(0, $D - $rl_margin);
- $si-- if $si > 0 && $si != length($prompt) && !&OnSecondByte($si);
- } elsif ($si + $rl_screen_width <= $D) { # Point to the right
- $si = &min(length($dline), ($D - $rl_screen_width) + $rl_margin);
- $si-- if $si > 0 && $si != length($prompt) && !&OnSecondByte($si);
- } elsif (length($dline) - $si < $rl_screen_width - $rl_margin and $si) {
- # Too little of the line shown
- $si = &max(0, length($dline) - $rl_screen_width + 3);
- $si-- if $si > 0 && $si != length($prompt) && !&OnSecondByte($si);
- } else {
- ## Fine as-is.... don't need to change $si.
- }
- $have_bra = 1 if $si != 0; # Need the "chopped-off" marker
-
- $thislen = &min(length($dline) - $si, $rl_screen_width);
- if ($si + $thislen < length($dline)) {
- ## need to place a '>'... make sure to place on first byte.
- $thislen-- if &OnSecondByte($si+$thislen-1);
- substr($dline, $si+$thislen-1,1) = '>';
- $have_ket = 1;
- }
-
- ##
- ## Now know what to display.
- ## Must get substr($dline, $si, $thislen) on the screen,
- ## with the cursor at $D-$si characters from the left edge.
- ##
- $dline = substr($dline, $si, $thislen);
- $delta = $D - $si; ## delta is cursor distance from beginning of $dline.
- if (defined $bsel) {
- $bsel -= $si;
- $esel = $delta;
- ($bsel, $esel) = ($esel, $bsel) if $bsel > $esel;
- $bsel = 0 if $bsel < 0;
- if ($have_ket) {
- $esel = $thislen - 1 if $esel > $thislen - 1;
- } else {
- $esel = $thislen if $esel > $thislen;
- }
- }
- if ($si >= length($prompt)) { # Keep $dline for $lastredisplay...
- $prompt = ($have_bra ? "<" : "");
- $dline = substr $dline, 1; # After prompt
- $bsel = 1 if defined $bsel and $bsel == 0;
- } else {
- $dline = substr($dline, (length $prompt) - $si);
- $prompt = substr($prompt,$si);
- substr($prompt, 0, 1) = '<' if $si > 0;
- }
- # Now $dline is the part after the prompt...
-
- ##
- ## Now must output $dline, with cursor $delta spaces from left of TTY
- ##
-
- local ($\, $,) = ('','');
-
- ##
- ## If $force_redraw is not set, we can attempt to optimize the redisplay
- ## However, if we don't happen to find an easy way to optimize, we just
- ## fall through to the brute-force method of re-drawing the whole line.
- ##
- if (not $force_redraw and not defined $bsel)
- {
- ## can try to optimize here a bit.
-
- ## For when we only need to move the cursor
- if ($lastredisplay eq $dline and $lastpromptlen == length $prompt) {
- ## If we need to move forward, just overwrite as far as we need.
- if ($lastdelta < $delta) {
- print $term_OUT
- substr_with_props($prompt, $dline,
- $lastdelta, $delta-$lastdelta, $have_ket);
- ## Need to move back.
- } elsif($lastdelta > $delta) {
- ## Two ways to move back... use the fastest. One is to just
- ## backspace the proper amount. The other is to jump to the
- ## the beginning of the line and overwrite from there....
- my $out = substr_with_props($prompt, $dline, 0, $delta, $have_ket);
- if ($lastdelta - $delta <= length $out) {
- print $term_OUT "\b" x ($lastdelta - $delta);
- } else {
- print $term_OUT "\r", $out;
- }
- }
- ($lastlen, $lastredisplay, $lastdelta, $lastpromptlen)
- = ($thislen, $dline, $delta, length $prompt);
- # print $term_OUT "\a"; # Debugging
- return;
- }
-
- ## for when we've just added stuff to the end
- if ($thislen > $lastlen &&
- $lastdelta == $lastlen &&
- $delta == $thislen &&
- $lastpromptlen == length($prompt) &&
- substr($dline, 0, $lastlen - $lastpromptlen) eq $lastredisplay)
- {
- print $term_OUT substr_with_props($prompt, $dline,
- $lastdelta, undef, $have_ket);
- # print $term_OUT "\a"; # Debugging
- ($lastlen, $lastredisplay, $lastdelta, $lastpromptlen)
- = ($thislen, $dline, $delta, length $prompt);
- return;
- }
-
- ## There is much more opportunity for optimizing.....
- ## something to work on later.....
- }
-
- ##
- ## Brute force method of redisplaying... redraw the whole thing.
- ##
-
- print $term_OUT "\r", substr_with_props($prompt, $dline, 0, undef, $have_ket, $bsel, $esel);
- my $back = length ($dline) + length ($prompt) - $delta;
- $back += $lastlen - $thislen,
- print $term_OUT ' ' x ($lastlen - $thislen) if $lastlen > $thislen;
-
- if ($back) {
- my $out = substr_with_props($prompt, $dline, 0, $delta, $have_ket, $bsel, $esel);
- if ($back <= length $out and not defined $bsel) {
- print $term_OUT "\b" x $back;
- } else {
- print $term_OUT "\r", $out;
- }
- }
-
- ($lastlen, $lastredisplay, $lastdelta, $lastpromptlen)
- = ($thislen, $dline, $delta, length $prompt);
-
- $force_redraw = 0;
-}
-
-sub min { $_[0] < $_[1] ? $_[0] : $_[1]; }
-
-sub getc_with_pending {
-
- my $key = @Pending ? shift(@Pending) : &$rl_getc;
-
- # Save keystrokes for vi '.' command
- push(@$Dot_buf, $key) if $Dot_buf;
-
- $key;
-}
-
-sub rl_getc {
- my $key; # JP: Added missing declaration
- if (defined $term_readkey) { # XXXX ???
- $Term::ReadLine::Perl::term->Tk_loop
- if $Term::ReadLine::toloop && defined &Tk::DoOneEvent;
- $key = Term::ReadKey::ReadKey(0, $term_IN);
- } else {
- $key = $Term::ReadLine::Perl::term->get_c;
- }
-}
-
-##
-## get_command(keymap, ord_command_char)
-##
-## If the KEYMAP has an entry for COMMAND, it is returned.
-## Otherwise, the default command is returned.
-##
-sub get_command
-{
- local *KeyMap = shift;
- my ($key) = @_;
- my $cmd = defined($KeyMap[$key]) ? $KeyMap[$key]
- : ($KeyMap{'default'} || 'F_Ding');
- if (!defined($cmd) || $cmd eq ''){
- warn "internal error (key=$key)";
- $cmd = 'F_Ding';
- }
- $cmd
-}
-
-##
-## do_command(keymap, numericarg, command)
-##
-## If the KEYMAP has an entry for COMMAND, it is executed.
-## Otherwise, the default command for the keymap is executed.
-##
-sub do_command
-{
- my ($keymap, $count, $key) = @_;
- my $cmd = get_command($keymap, $key);
-
- local *KeyMap = $keymap; # &$cmd may expect it...
- &$cmd($count, $key);
- $lastcommand = $cmd;
-}
-
-##
-## Save whatever state we wish to save as an anonymous array.
-## The only other function that needs to know about its encoding is getstate/preserve_state.
-##
-sub savestate
-{
- [$D, $si, $LastCommandKilledText, $KillBuffer, $line, @_];
-}
-
-# consolidate only-movement changes together...
-sub preserve_state {
- return if $Vi_mode;
- push(@undo, savestate()), return unless @undo;
- my $last = $undo[-1];
- my @only_movement;
- if ( #$last->[1] == $si and $last->[2] eq $LastCommandKilledText
- # and $last->[3] eq $KillBuffer and
- $last->[4] eq $line ) {
- # Only position changed; remove old only-position-changed records
- pop @undo if $undo[-1]->[5];
- @only_movement = 1;
- }
- push(@undo, savestate(@only_movement));
-}
-
-##
-## $_[1] is an ASCII ordinal; inserts as per $count.
-##
-sub F_SelfInsert
-{
- remove_selection();
- my ($count, $ord) = @_;
- my $text2add = pack('C', $ord) x $count;
- if ($InsertMode) {
- substr($line,$D,0) .= $text2add;
- } else {
- ## note: this can screw up with 2-byte characters.
- substr($line,$D,length($text2add)) = $text2add;
- }
- $D += length($text2add);
-}
-
-##
-## Return the line as-is to the user.
-##
-sub F_AcceptLine
-{
- &add_line_to_history;
- $AcceptLine = $line;
- local $\ = '';
- print $term_OUT "\r\n";
- $force_redraw = 0;
- (pos $line) = undef; # Another way to force redraw...
-}
-
-sub add_line_to_history
-{
- ## Insert into history list if:
- ## * bigger than the minimal length
- ## * not same as last entry
- ##
- if (length($line) >= $minlength
- && (!@rl_History || $rl_History[$#rl_History] ne $line)
- ) {
- ## if the history list is full, shift out an old one first....
- while (@rl_History >= $rl_MaxHistorySize) {
- shift(@rl_History);
- $rl_HistoryIndex--;
- }
-
- push(@rl_History, $line); ## tack new one on the end
- }
-}
-
-
-sub remove_selection {
- if ( $rl_first_char && length $line && $rl_default_selected ) {
- $line = '';
- $D = 0;
- return 1;
- }
- if ($rl_delete_selection and defined pos $line and $D != pos $line) {
- kill_text(pos $line, $D);
- return 1;
- }
- return;
-}
-
-#sub F_ReReadInitFile;
-#sub rl_getc;
-sub F_ForwardChar;
-sub F_BackwardChar;
-sub F_BeginningOfLine;
-sub F_EndOfLine;
-sub F_ForwardWord;
-sub F_BackwardWord;
-sub F_RedrawCurrentLine;
-sub F_ClearScreen;
-# sub F_SelfInsert;
-sub F_QuotedInsert;
-sub F_TabInsert;
-#sub F_AcceptLine;
-sub F_OperateAndGetNext;
-sub F_BackwardDeleteChar;
-sub F_DeleteChar;
-sub F_UnixWordRubout;
-sub F_UnixLineDiscard;
-sub F_UpcaseWord;
-sub F_DownCaseWord;
-sub F_CapitalizeWord;
-sub F_TransposeWords;
-sub F_TransposeChars;
-sub F_PreviousHistory;
-sub F_NextHistory;
-sub F_BeginningOfHistory;
-sub F_EndOfHistory;
-sub F_ReverseSearchHistory;
-sub F_ForwardSearchHistory;
-sub F_HistorySearchBackward;
-sub F_HistorySearchForward;
-sub F_KillLine;
-sub F_BackwardKillLine;
-sub F_Yank;
-sub F_YankPop;
-sub F_YankNthArg;
-sub F_KillWord;
-sub F_BackwardKillWord;
-sub F_Abort;
-sub F_DoLowercaseVersion;
-sub F_DoMetaVersion;
-sub F_DoControlVersion;
-sub F_Undo;
-sub F_RevertLine;
-sub F_EmacsEditingMode;
-sub F_Interrupt;
-sub F_PrefixMeta;
-sub F_UniversalArgument;
-sub F_DigitArgument;
-sub F_OverwriteMode;
-sub F_InsertMode;
-sub F_ToggleInsertMode;
-sub F_Suspend;
-sub F_Ding;
-sub F_PossibleCompletions;
-sub F_Complete;
-sub F_YankClipboard;
-sub F_CopyRegionAsKillClipboard;
-sub F_KillRegionClipboard;
-sub clipboard_set;
-sub F_BeginUndoGroup;
-sub F_EndUndoGroup;
-sub F_DoNothing;
-sub F_ForceMemorizeDigitArgument;
-sub F_MemorizeDigitArgument;
-sub F_UnmemorizeDigitArgument;
-sub F_ResetDigitArgument;
-sub F_MergeInserts;
-sub F_MemorizePos;
-sub F_BeginPasteGroup;
-sub F_EndPasteGroup;
-sub F_BeginEditGroup;
-sub F_EndEditGroup;
-
-# Comment next line and __DATA__ line below to disable the selfloader.
-
-use SelfLoader;
-
-1;
-
-__DATA__
-
-# From here on anything may be autoloaded
-
-sub max { $_[0] > $_[1] ? $_[0] : $_[1]; }
-sub isupper { ord($_[0]) >= ord('A') && ord($_[0]) <= ord('Z'); }
-sub islower { ord($_[0]) >= ord('a') && ord($_[0]) <= ord('z'); }
-sub toupper { &islower ? pack('c', ord($_[0])-ord('a')+ord('A')) : $_[0];}
-sub tolower { &isupper ? pack('c', ord($_[0])-ord('A')+ord('a')) : $_[0];}
-
-##
-## rl_set(var_name, value_string)
-##
-## Sets the named variable as per the given value, if both are appropriate.
-## Allows the user of the package to set such things as HorizontalScrollMode
-## and EditingMode. Value_string may be of the form
-## HorizontalScrollMode
-## horizontal-scroll-mode
-##
-## Also called during the parsing of ~/.inputrc for "set var value" lines.
-##
-## The previous value is returned, or undef on error.
-###########################################################################
-## Consider the following example for how to add additional variables
-## accessible via rl_set (and hence via ~/.inputrc).
-##
-## Want:
-## We want an external variable called "FooTime" (or "foo-time").
-## It may have values "January", "Monday", or "Noon".
-## Internally, we'll want those values to translate to 1, 2, and 12.
-##
-## How:
-## Have an internal variable $var_FooTime that will represent the current
-## internal value, and initialize it to the default value.
-## Make an array %var_FooTime whose keys and values are are the external
-## (January, Monday, Noon) and internal (1, 2, 12) values:
-##
-## $var_FooTime = $var_FooTime{'January'} = 1; #default
-## $var_FooTime{'Monday'} = 2;
-## $var_FooTime{'Noon'} = 12;
-##
-sub rl_set
-{
- local($var, $val) = @_;
-
- # &preinit's keys are all Capitalized
- $val = ucfirst lc $val if $val =~ /^(on|off)$/i;
-
- $var = 'CompleteAddsuffix' if $var eq 'visible-stats';
-
- ## if the variable is in the form "some-name", change to "SomeName"
- local($_) = "\u$var";
- local($return) = undef;
- s/-(.)/\u$1/g;
-
- # Skip unknown variables:
- return unless defined $ {'readline::'}{"var_$_"};
- local(*V) = $ {'readline::'}{"var_$_"};
- if (!defined($V)) { # XXX Duplicate check?
- warn("Warning$InputLocMsg:\n".
- " Invalid variable `$var'\n") if $^W;
- } elsif (!defined($V{$val})) {
- local(@selections) = keys(%V);
- warn("Warning$InputLocMsg:\n".
- " Invalid value `$val' for variable `$var'.\n".
- " Choose from [@selections].\n") if $^W;
- } else {
- $return = $V;
- $V = $V{$val}; ## make the setting
- }
- $return;
-}
-
-##
-## OnSecondByte($index)
-##
-## Returns true if the byte at $index into $line is the second byte
-## of a two-byte character.
-##
-sub OnSecondByte
-{
- return 0 if !$_rl_japanese_mb || $_[0] == 0 || $_[0] == length($line);
-
- die 'internal error' if $_[0] > length($line);
-
- ##
- ## must start looking from the beginning of the line .... can
- ## have one- and two-byte characters interspersed, so can't tell
- ## without starting from some know location.....
- ##
- local($i);
- for ($i = 0; $i < $_[0]; $i++) {
- next if ord(substr($line, $i, 1)) < 0x80;
- ## We have the first byte... must bump up $i to skip past the 2nd.
- ## If that one we're skipping past is the index, it should be changed
- ## to point to the first byte of the pair (therefore, decremented).
- return 1 if ++$i == $_[0];
- }
- 0; ## seemed to be OK.
-}
-
-##
-## CharSize(index)
-##
-## Returns the size of the character at the given INDEX in the
-## current line. Most characters are just one byte in length,
-## but if the byte at the index and the one after has the high
-## bit set those two bytes are one character of size=2.
-##
-## Assumes that index points to the first of a 2-byte char if not
-## pointing to a 2-byte char.
-##
-sub CharSize
-{
- return 2 if $_rl_japanese_mb &&
- ord(substr($line, $_[0], 1)) >= 0x80 &&
- ord(substr($line, $_[0]+1, 1)) >= 0x80;
- 1;
-}
-
-sub GetTTY
-{
- $base_termios = $termios; # make it long enough
- &ioctl($term_IN,$TCGETS,$base_termios) || die "Can't ioctl TCGETS: $!";
-}
-
-sub XonTTY
-{
- # I don't know which of these I actually need to do this to, so we'll
- # just cover all bases.
-
- &ioctl($term_IN,$TCXONC,$TCOON); # || die "Can't ioctl TCXONC STDIN: $!";
- &ioctl($term_OUT,$TCXONC,$TCOON); # || die "Can't ioctl TCXONC STDOUT: $!";
-}
-
-sub ___SetTTY
-{
-# print "before SetTTY\n\r";
-# system 'stty -a';
-
- &XonTTY;
-
- &GetTTY
- if !defined($base_termios);
-
- @termios = unpack($termios_t,$base_termios);
- $termios[$TERMIOS_IFLAG] |= $TERMIOS_READLINE_ION;
- $termios[$TERMIOS_IFLAG] &= ~$TERMIOS_READLINE_IOFF;
- $termios[$TERMIOS_OFLAG] |= $TERMIOS_READLINE_OON;
- $termios[$TERMIOS_OFLAG] &= ~$TERMIOS_READLINE_OOFF;
- $termios[$TERMIOS_LFLAG] |= $TERMIOS_READLINE_LON;
- $termios[$TERMIOS_LFLAG] &= ~$TERMIOS_READLINE_LOFF;
- $termios[$TERMIOS_VMIN] = 1;
- $termios[$TERMIOS_VTIME] = 0;
- $termios = pack($termios_t,@termios);
- &ioctl($term_IN,$TCSETS,$termios) || die "Can't ioctl TCSETS: $!";
-
-# print "after SetTTY\n\r";
-# system 'stty -a';
-}
-
-sub normal_tty_mode
-{
- return if $stdin_not_tty || $dumb_term || !$initialized;
- &XonTTY;
- &GetTTY if !defined($base_termios);
- &ResetTTY;
-}
-
-sub ___ResetTTY
-{
-# print "before ResetTTY\n\r";
-# system 'stty -a';
-
- @termios = unpack($termios_t,$base_termios);
- $termios[$TERMIOS_IFLAG] |= $TERMIOS_NORMAL_ION;
- $termios[$TERMIOS_IFLAG] &= ~$TERMIOS_NORMAL_IOFF;
- $termios[$TERMIOS_OFLAG] |= $TERMIOS_NORMAL_OON;
- $termios[$TERMIOS_OFLAG] &= ~$TERMIOS_NORMAL_OOFF;
- $termios[$TERMIOS_LFLAG] |= $TERMIOS_NORMAL_LON;
- $termios[$TERMIOS_LFLAG] &= ~$TERMIOS_NORMAL_LOFF;
- $termios = pack($termios_t,@termios);
- &ioctl($term_IN,$TCSETS,$termios) || die "Can't ioctl TCSETS: $!";
-
-# print "after ResetTTY\n\r";
-# system 'stty -a';
-}
-
-##
-## WordBreak(index)
-##
-## Returns true if the character at INDEX into $line is a basic word break
-## character, false otherwise.
-##
-sub WordBreak
-{
- index($rl_basic_word_break_characters, substr($line,$_[0],1)) != -1;
-}
-
-sub getstate
-{
- ($D, $si, $LastCommandKilledText, $KillBuffer, $line) = @{$_[0]};
- $ThisCommandKilledText = $LastCommandKilledText;
-}
-
-##
-## kills from D=$_[0] to $_[1] (to the killbuffer if $_[2] is true)
-##
-sub kill_text
-{
- my($from, $to, $save) = (&min($_[0], $_[1]), &max($_[0], $_[1]), $_[2]);
- my $len = $to - $from;
- if ($save) {
- $KillBuffer = '' if !$LastCommandKilledText;
- if ($from < $LastCommandKilledText - 1) {
- $KillBuffer = substr($line, $from, $len) . $KillBuffer;
- } else {
- $KillBuffer .= substr($line, $from, $len);
- }
- $ThisCommandKilledText = 1 + $from;
- }
- substr($line, $from, $len) = '';
-
- ## adjust $D
- if ($D > $from) {
- $D -= $len;
- $D = $from if $D < $from;
- }
-}
-
-
-###########################################################################
-## Bindable functions... pretty much in the same order as in readline.c ###
-###########################################################################
-
-##
-## Returns true if $D at the end of the line.
-##
-sub at_end_of_line
-{
- ($D + &CharSize($D)) == (length($line) + 1);
-}
-
-
-##
-## Move forward (right) $count characters.
-##
-sub F_ForwardChar
-{
- my $count = shift;
- return &F_BackwardChar(-$count) if $count < 0;
-
- while (!&at_end_of_line && $count-- > 0) {
- $D += &CharSize($D);
- }
-}
-
-##
-## Move backward (left) $count characters.
-##
-sub F_BackwardChar
-{
- my $count = shift;
- return &F_ForwardChar(-$count) if $count < 0;
-
- while (($D > 0) && ($count-- > 0)) {
- $D--; ## Move back one regardless,
- $D-- if &OnSecondByte($D); ## another if over a big char.
- }
-}
-
-##
-## Go to beginning of line.
-##
-sub F_BeginningOfLine
-{
- $D = 0;
-}
-
-##
-## Move to the end of the line.
-##
-sub F_EndOfLine
-{
- &F_ForwardChar(100) while !&at_end_of_line;
-}
-
-##
-## Move to the end of this/next word.
-## Done as many times as $count says.
-##
-sub F_ForwardWord
-{
- my $count = shift;
- return &F_BackwardWord(-$count) if $count < 0;
-
- while (!&at_end_of_line && $count-- > 0)
- {
- ## skip forward to the next word (if not already on one)
- &F_ForwardChar(1) while !&at_end_of_line && &WordBreak($D);
- ## skip forward to end of word
- &F_ForwardChar(1) while !&at_end_of_line && !&WordBreak($D);
- }
-}
-
-##
-##
-## Move to the beginning of this/next word.
-## Done as many times as $count says.
-##
-sub F_BackwardWord
-{
- my $count = shift;
- return &F_ForwardWord(-$count) if $count < 0;
-
- while ($D > 0 && $count-- > 0) {
- ## skip backward to the next word (if not already on one)
- &F_BackwardChar(1) while (($D > 0) && &WordBreak($D-1));
- ## skip backward to start of word
- &F_BackwardChar(1) while (($D > 0) && !&WordBreak($D-1));
- }
-}
-
-##
-## Refresh the input line.
-##
-sub F_RedrawCurrentLine
-{
- $force_redraw = 1;
-}
-
-##
-## Clear the screen and refresh the line.
-## If given a numeric arg other than 1, simply refreshes the line.
-##
-sub F_ClearScreen
-{
- my $count = shift;
- return &F_RedrawCurrentLine if $count != 1;
-
- $rl_CLEAR = `clear` if !defined($rl_CLEAR);
- local $\ = '';
- print $term_OUT $rl_CLEAR;
- $force_redraw = 1;
-}
-
-##
-## Insert the next character read verbatim.
-##
-sub F_QuotedInsert
-{
- my $count = shift;
- &F_SelfInsert($count, ord(&getc_with_pending));
-}
-
-##
-## Insert a tab.
-##
-sub F_TabInsert
-{
- my $count = shift;
- &F_SelfInsert($count, ord("\t"));
-}
-
-## Operate - accept the current line and fetch from the
-## history the next line relative to current line for default.
-sub F_OperateAndGetNext
-{
- my $count = shift;
-
- &F_AcceptLine;
-
- my $remainingEntries = $#rl_History - $rl_HistoryIndex;
- if ($count > 0 && $remainingEntries >= 0) { # there is something to repeat
- if ($remainingEntries > 0) { # if we are not on last line
- $rl_HistoryIndex++; # fetch next one
- $count = $remainingEntries if $count > $remainingEntries;
- }
- $rl_OperateCount = $count;
- }
-}
-
-##
-## Removes $count chars to left of cursor (if not at beginning of line).
-## If $count > 1, deleted chars saved to kill buffer.
-##
-sub F_BackwardDeleteChar
-{
- return if remove_selection();
-
- my $count = shift;
- return F_DeleteChar(-$count) if $count < 0;
- my $oldD = $D;
- &F_BackwardChar($count);
- return if $D == $oldD;
- &kill_text($oldD, $D, $count > 1);
-}
-
-##
-## Removes the $count chars from under the cursor.
-## If there is no line and the last command was different, tells
-## readline to return EOF.
-## If there is a line, and the cursor is at the end of it, and we're in
-## tcsh completion mode, then list possible completions.
-## If $count > 1, deleted chars saved to kill buffer.
-##
-sub F_DeleteChar
-{
- return if remove_selection();
-
- my $count = shift;
- return F_DeleteBackwardChar(-$count) if $count < 0;
- if (length($line) == 0) { # EOF sent (probably OK in DOS too)
- $AcceptLine = $ReturnEOF = 1 if $lastcommand ne 'F_DeleteChar';
- return;
- }
- if ($D == length ($line))
- {
- &complete_internal('?') if $var_TcshCompleteMode;
- return;
- }
- my $oldD = $D;
- &F_ForwardChar($count);
- return if $D == $oldD;
- &kill_text($oldD, $D, $count > 1);
-}
-
-##
-## Kill to previous whitespace.
-##
-sub F_UnixWordRubout
-{
- return &F_Ding if $D == 0;
- (my $oldD, local $rl_basic_word_break_characters) = ($D, "\t ");
- # JP: Fixed a bug here - both were 'my'
- F_BackwardWord(1);
- kill_text($D, $oldD, 1);
-}
-
-##
-## Kill line from cursor to beginning of line.
-##
-sub F_UnixLineDiscard
-{
- return &F_Ding if $D == 0;
- kill_text(0, $D, 1);
-}
-
-sub F_UpcaseWord { &changecase($_[0], 'up'); }
-sub F_DownCaseWord { &changecase($_[0], 'down'); }
-sub F_CapitalizeWord { &changecase($_[0], 'cap'); }
-
-##
-## Translated from GNUs readline.c
-## One arg is 'up' to upcase $_[0] words,
-## 'down' to downcase them,
-## or something else to capitolize them.
-## If $_[0] is negative, the dot is not moved.
-##
-sub changecase
-{
- my $op = $_[1];
-
- my ($start, $state, $c, $olddot) = ($D, 0);
- if ($_[0] < 0)
- {
- $olddot = $D;
- $_[0] = -$_[0];
- }
-
- &F_ForwardWord; ## goes forward $_[0] words.
-
- while ($start < $D) {
- $c = substr($line, $start, 1);
-
- if ($op eq 'up') {
- $c = &toupper($c);
- } elsif ($op eq 'down') {
- $c = &tolower($c);
- } else { ## must be 'cap'
- if ($state == 1) {
- $c = &tolower($c);
- } else {
- $c = &toupper($c);
- $state = 1;
- }
- $state = 0 if $c !~ tr/a-zA-Z//;
- }
-
- substr($line, $start, 1) = $c;
- $start++;
- }
- $D = $olddot if defined($olddot);
-}
-
-sub F_TransposeWords {
- my $c = shift;
- return F_Ding() unless $c;
- # Find "this" word
- F_BackwardWord(1);
- my $p0 = $D;
- F_ForwardWord(1);
- my $p1 = $D;
- return F_Ding() if $p1 == $p0;
- my ($p2, $p3) = ($p0, $p1);
- if ($c > 0) {
- F_ForwardWord($c);
- $p3 = $D;
- F_BackwardWord(1);
- $p2 = $D;
- } else {
- F_BackwardWord(1 - $c);
- $p0 = $D;
- F_ForwardWord(1);
- $p1 = $D;
- }
- return F_Ding() if $p3 == $p2 or $p2 < $p1;
- my $r = substr $line, $p2, $p3 - $p2;
- substr($line, $p2, $p3 - $p2) = substr $line, $p0, $p1 - $p0;
- substr($line, $p0, $p1 - $p0) = $r;
- $D = $c > 0 ? $p3 : $p0 + $p3 - $p2; # End of "this" word after edit
- return 1;
-## Exchange words: C-Left, C-right, C-right, C-left. If positions do
-## not overlap, we get two things to transpose. Repeat count?
-}
-
-##
-## Switch char at dot with char before it.
-## If at the end of the line, switch the previous two...
-## (NOTE: this could screw up multibyte characters.. should do correctly)
-sub F_TransposeChars
-{
- if ($D == length($line) && $D >= 2) {
- substr($line,$D-2,2) = substr($line,$D-1,1).substr($line,$D-2,1);
- } elsif ($D >= 1) {
- substr($line,$D-1,2) = substr($line,$D,1) .substr($line,$D-1,1);
- } else {
- &F_Ding;
- }
-}
-
-sub F_PreviousHistory {
- &get_line_from_history($rl_HistoryIndex - shift);
-}
-
-sub F_NextHistory {
- &get_line_from_history($rl_HistoryIndex + shift);
-}
-
-
-
-sub F_BeginningOfHistory
-{
- &get_line_from_history(0);
-}
-
-sub F_EndOfHistory
-{
- &get_line_from_history(@rl_History);
-}
-
-sub F_ReverseSearchHistory
-{
- &DoSearch($_[0] >= 0 ? 1 : 0);
-}
-
-sub F_ForwardSearchHistory
-{
- &DoSearch($_[0] >= 0 ? 0 : 1);
-}
-
-sub F_HistorySearchBackward
-{
- &DoSearchStart(($_[0] >= 0 ? 1 : 0),substr($line,0,$D));
-}
-
-sub F_HistorySearchForward
-{
- &DoSearchStart(($_[0] >= 0 ? 0 : 1),substr($line,0,$D));
-}
-
-## returns a new $i or -1 if not found.
-sub search {
- my ($i, $str) = @_;
- return -1 if $i < 0 || $i > $#rl_History; ## for safety
- while (1) {
- return $i if rindex($rl_History[$i], $str) >= 0;
- if ($reverse) {
- return -1 if $i-- == 0;
- } else {
- return -1 if $i++ == $#rl_History;
- }
- }
-}
-
-sub DoSearch
-{
- local $reverse = shift; # Used in search()
- my $oldline = $line;
- my $oldD = $D;
-
- my $searchstr = ''; ## string we're searching for
- my $I = -1; ## which history line
-
- $si = 0;
-
- while (1)
- {
- if ($I != -1) {
- $line = $rl_History[$I];
- $D += index($rl_History[$I], $searchstr);
- }
- &redisplay( '('.($reverse?'reverse-':'') ."i-search) `$searchstr': ");
-
- $c = &getc_with_pending;
- if ($KeyMap[ord($c)] eq 'F_ReverseSearchHistory') {
- if ($reverse && $I != -1) {
- if ($tmp = &search($I-1,$searchstr), $tmp >= 0) {
- $I = $tmp;
- } else {
- &F_Ding;
- }
- }
- $reverse = 1;
- } elsif ($KeyMap[ord($c)] eq 'F_ForwardSearchHistory') {
- if (!$reverse && $I != -1) {
- if ($tmp = &search($I+1,$searchstr), $tmp >= 0) {
- $I = $tmp;
- } else {
- &F_Ding;
- }
- }
- $reverse = 0;
- } elsif ($c eq "\007") { ## abort search... restore line and return
- $line = $oldline;
- $D = $oldD;
- return;
- } elsif (ord($c) < 32 || ord($c) > 126) {
- push(@Pending, $c) if $c ne "\e";
- if ($I < 0) {
- ## just restore
- $line = $oldline;
- $D = $oldD;
- } else {
- #chose this line
- $line = $rl_History[$I];
- $D = index($rl_History[$I], $searchstr);
- }
- &redisplay();
- last;
- } else {
- ## Add this character to the end of the search string and
- ## see if that'll match anything.
- $tmp = &search($I < 0 ? $rl_HistoryIndex-$reverse: $I, $searchstr.$c);
- if ($tmp == -1) {
- &F_Ding;
- } else {
- $searchstr .= $c;
- $I = $tmp;
- }
- }
- }
-}
-
-## returns a new $i or -1 if not found.
-sub searchStart {
- my ($i, $reverse, $str) = @_;
- $i += $reverse ? - 1: +1;
- return -1 if $i < 0 || $i > $#rl_History; ## for safety
- while (1) {
- return $i if index($rl_History[$i], $str) == 0;
- if ($reverse) {
- return -1 if $i-- == 0;
- } else {
- return -1 if $i++ == $#rl_History;
- }
- }
-}
-
-sub DoSearchStart
-{
- my ($reverse,$what) = @_;
- my $i = searchStart($rl_HistoryIndex, $reverse, $what);
- return if $i == -1;
- $rl_HistoryIndex = $i;
- ($D, $line) = (0, $rl_History[$rl_HistoryIndex]);
- F_BeginningOfLine();
- F_ForwardChar(length($what));
-
-}
-
-###########################################################################
-###########################################################################
-
-##
-## Kill from cursor to end of line.
-##
-sub F_KillLine
-{
- my $count = shift;
- return F_BackwardKillLine(-$count) if $count < 0;
- kill_text($D, length($line), 1);
-}
-
-##
-## Delete from cursor to beginning of line.
-##
-sub F_BackwardKillLine
-{
- my $count = shift;
- return F_KillLine(-$count) if $count < 0;
- return F_Ding if $D == 0;
- kill_text(0, $D, 1);
-}
-
-##
-## TextInsert(count, string)
-##
-sub TextInsert {
- my $count = shift;
- my $text2add = shift(@_) x $count;
- if ($InsertMode) {
- substr($line,$D,0) .= $text2add;
- } else {
- substr($line,$D,length($text2add)) = $text2add;
- }
- $D += length($text2add);
-}
-
-sub F_Yank
-{
- remove_selection();
- &TextInsert($_[0], $KillBuffer);
-}
-
-sub F_YankPop {
- 1;
- ## not implemented yet
-}
-
-sub F_YankNthArg {
- 1;
- ## not implemented yet
-}
-
-##
-## Kill to the end of the current word. If not on a word, kill to
-## the end of the next word.
-##
-sub F_KillWord
-{
- my $count = shift;
- return &F_BackwardKillWord(-$count) if $count < 0;
- my $oldD = $D;
- &F_ForwardWord($count); ## moves forward $count words.
- kill_text($oldD, $D, 1);
-}
-
-##
-## Kill backward to the start of the current word, or, if currently
-## not on a word (or just at the start of a word), to the start of the
-## previous word.
-##
-sub F_BackwardKillWord
-{
- my $count = shift;
- return F_KillWord(-$count) if $count < 0;
- my $oldD = $D;
- &F_BackwardWord($count); ## moves backward $count words.
- kill_text($D, $oldD, 1);
-}
-
-###########################################################################
-###########################################################################
-
-
-##
-## Abort the current input.
-##
-sub F_Abort
-{
- &F_Ding;
-}
-
-
-##
-## If the character that got us here is upper case,
-## do the lower-case equiv...
-##
-sub F_DoLowercaseVersion
-{
- if ($_[1] >= ord('A') && $_[1] <= ord('Z')) {
- &do_command(*KeyMap, $_[0], $_[1] - ord('A') + ord('a'));
- } else {
- &F_Ding;
- }
-}
-
-##
-## do the equiv with control key...
-##
-sub F_DoControlVersion
-{
- local *KeyMap = $var_EditingMode;
- my $key = $_[1];
-
- if ($key == ord('?')) {
- $key = 0x7F;
- } else {
- $key &= ~(0x80 | 0x60);
- }
- &do_command(*KeyMap, $_[0], $key);
-}
-
-##
-## do the equiv with meta key...
-##
-sub F_DoMetaVersion
-{
- local *KeyMap = $var_EditingMode;
- unshift @Pending, chr $_[1];
-
- &do_command(*KeyMap, $_[0], ord "\e");
-}
-
-##
-## If the character that got us here is Alt-Char,
-## do the Esc Char equiv...
-##
-sub F_DoEscVersion
-{
- my ($ord, $t) = $_[1];
- &F_Ding unless $KeyMap{'Esc'};
- for $t (([ord 'w', '`1234567890-='],
- [ord ',', 'zxcvbnm,./\\'],
- [16, 'qwertyuiop[]'],
- [ord(' ') - 2, 'asdfghjkl;\''])) {
- next unless $ord >= $t->[0] and $ord < $t->[0] + length($t->[1]);
- $ord = ord substr $t->[1], $ord - $t->[0], 1;
- return &do_command($KeyMap{'Esc'}, $_[0], $ord);
- }
- &F_Ding;
-}
-
-##
-## Undo one level.
-##
-sub F_Undo
-{
- pop(@undo); # unless $undo[-1]->[5]; ## get rid of the state we just put on, so we can go back one.
- if (@undo) {
- &getstate(pop(@undo));
- } else {
- &F_Ding;
- }
-}
-
-##
-## Replace the current line to some "before" state.
-##
-sub F_RevertLine
-{
- if ($rl_HistoryIndex >= $#rl_History+1) {
- $line = $line_for_revert;
- } else {
- $line = $rl_History[$rl_HistoryIndex];
- }
- $D = length($line);
-}
-
-sub F_EmacsEditingMode
-{
- $var_EditingMode = $var_EditingMode{'emacs'};
- $Vi_mode = 0;
-}
-
-###########################################################################
-###########################################################################
-
-
-##
-## (Attempt to) interrupt the current program.
-##
-sub F_Interrupt
-{
- local $\ = '';
- print $term_OUT "\r\n";
- &ResetTTY;
- kill ("INT", 0);
-
- ## We're back.... must not have died.
- $force_redraw = 1;
-}
-
-##
-## Execute the next character input as a command in a meta keymap.
-##
-sub F_PrefixMeta
-{
- my($count, $keymap) = ($_[0], "$KeyMap{'name'}_$_[1]");
- ##print "F_PrefixMeta [$keymap]\n\r";
- die "<internal error, $_[1]>" unless %$keymap;
- do_command(*$keymap, $count, ord(&getc_with_pending));
-}
-
-sub F_UniversalArgument
-{
- &F_DigitArgument;
-}
-
-##
-## For typing a numeric prefix to a command....
-##
-sub F_DigitArgument
-{
- my $in = chr $_[1];
- my ($NumericArg, $sawDigit) = (1, 0);
- my ($increment, $ord);
- ($NumericArg, $sawDigit) = ($_[0], $_[0] !~ /e0$/i)
- if $doingNumArg; # XXX What if Esc-- 1 ?
-
- do
- {
- $ord = ord $in;
- if (defined($KeyMap[$ord]) && $KeyMap[$ord] eq 'F_UniversalArgument') {
- $NumericArg *= 4;
- } elsif ($ord == ord('-') && !$sawDigit) {
- $NumericArg = -$NumericArg;
- } elsif ($ord >= ord('0') && $ord <= ord('9')) {
- $increment = ($ord - ord('0')) * ($NumericArg < 0 ? -1 : 1);
- if ($sawDigit) {
- $NumericArg = $NumericArg * 10 + $increment;
- } else {
- $NumericArg = $increment;
- $sawDigit = 1;
- }
- } else {
- local(*KeyMap) = $var_EditingMode;
- &redisplay();
- $doingNumArg = 1; # Allow NumArg inside NumArg
- &do_command(*KeyMap, $NumericArg . ($sawDigit ? '': 'e0'), $ord);
- return;
- }
- ## make sure it's not toooo big.
- if ($NumericArg > $rl_max_numeric_arg) {
- $NumericArg = $rl_max_numeric_arg;
- } elsif ($NumericArg < -$rl_max_numeric_arg) {
- $NumericArg = -$rl_max_numeric_arg;
- }
- &redisplay(sprintf("(arg %d) ", $NumericArg));
- } while defined($in = &getc_with_pending);
-}
-
-sub F_OverwriteMode
-{
- $InsertMode = 0;
-}
-
-sub F_InsertMode
-{
- $InsertMode = 1;
-}
-
-sub F_ToggleInsertMode
-{
- $InsertMode = !$InsertMode;
-}
-
-##
-## (Attempt to) suspend the program.
-##
-sub F_Suspend
-{
- if ($inDOS && length($line)==0) { # EOF sent
- $AcceptLine = $ReturnEOF = 1 if $lastcommand ne 'F_DeleteChar';
- return;
- }
- local $\ = '';
- print $term_OUT "\r\n";
- &ResetTTY;
- eval { kill ("TSTP", 0) };
- ## We're back....
- &SetTTY;
- $force_redraw = 1;
-}
-
-##
-## Ring the bell.
-## Should do something with $var_PreferVisibleBell here, but what?
-##
-sub F_Ding {
- local $\ = '';
- print $term_OUT "\007";
- return; # Undefined return value
-}
-
-##########################################################################
-#### command/file completion ############################################
-##########################################################################
-
-##
-## How Command Completion Works
-##
-## When asked to do a completion operation, readline isolates the word
-## to the immediate left of the cursor (i.e. what's just been typed).
-## This information is then passed to some function (which may be supplied
-## by the user of this package) which will return an array of possible
-## completions.
-##
-## If there is just one, that one is used. Otherwise, they are listed
-## in some way (depends upon $var_TcshCompleteMode).
-##
-## The default is to do filename completion. The function that performs
-## this task is readline'rl_filename_list.
-##
-## A minimal-trouble way to have command-completion is to call
-## readline'rl_basic_commands with an array of command names, such as
-## &readline'rl_basic_commands('quit', 'run', 'set', 'list')
-## Those command names will then be used for completion if the word being
-## completed begins the line. Otherwise, completion is disallowed.
-##
-## The way to have the most power is to provide a function to readline
-## which will accept information about a partial word that needs completed,
-## and will return the appropriate list of possibilities.
-## This is done by setting $readline'rl_completion_function to the name of
-## the function to run.
-##
-## That function will be called with three args ($text, $line, $start).
-## TEXT is the partial word that should be completed. LINE is the entire
-## input line as it stands, and START is the index of the TEXT in LINE
-## (i.e. zero if TEXT is at the beginning of LINE).
-##
-## A cool completion function will look at LINE and START and give context-
-## sensitive completion lists. Consider something that will do completion
-## for two commands
-## cat FILENAME
-## finger USERNAME
-## status [this|that|other]
-##
-## It (untested) might look like:
-##
-## $readline'rl_completion_function = "main'complete";
-## sub complete { local($text, $_, $start) = @_;
-## ## return commands which may match if at the beginning....
-## return grep(/^$text/, 'cat', 'finger') if $start == 0;
-## return &rl_filename_list($text) if /^cat\b/;
-## return &my_namelist($text) if /^finger\b/;
-## return grep(/^text/, 'this', 'that','other') if /^status\b/;
-## ();
-## }
-## Of course, a real completion function would be more robust, but you
-## get the idea (I hope).
-##
-
-##
-## List possible completions
-##
-sub F_PossibleCompletions
-{
- &complete_internal('?');
-}
-
-##
-## List possible completions
-##
-sub F_InsertPossibleCompletions
-{
- &complete_internal('*');
-}
-
-##
-## Do a completion operation.
-## If the last thing we did was a completion operation, we'll
-## now list the options available (under normal emacs mode).
-##
-## Under TcshCompleteMode, each contiguous subsequent completion operation
-## lists another of the possible options.
-##
-## Returns true if a completion was done, false otherwise, so vi completion
-## routines can test it.
-##
-sub F_Complete
-{
- if ($lastcommand eq 'F_Complete') {
- if ($var_TcshCompleteMode && @tcsh_complete_selections > 0) {
- substr($line, $tcsh_complete_start, $tcsh_complete_len)
- = $tcsh_complete_selections[0];
- $D -= $tcsh_complete_len;
- $tcsh_complete_len = length($tcsh_complete_selections[0]);
- $D += $tcsh_complete_len;
- push(@tcsh_complete_selections, shift(@tcsh_complete_selections));
- } else {
- &complete_internal('?') or return;
- }
- } else {
- @tcsh_complete_selections = ();
- &complete_internal("\t") or return;
- }
-
- 1;
-}
-
-##
-## The meat of command completion. Patterned closely after GNU's.
-##
-## The supposedly partial word at the cursor is "completed" as per the
-## single argument:
-## "\t" complete as much of the word as is unambiguous
-## "?" list possibilities.
-## "*" replace word with all possibilities. (who would use this?)
-##
-## A few notable variables used:
-## $rl_completer_word_break_characters
-## -- characters in this string break a word.
-## $rl_special_prefixes
-## -- but if in this string as well, remain part of that word.
-##
-## Returns true if a completion was done, false otherwise, so vi completion
-## routines can test it.
-##
-sub complete_internal
-{
- my $what_to_do = shift;
- my ($point, $end) = ($D, $D);
-
- # In vi mode, complete if the cursor is at the *end* of a word, not
- # after it.
- ($point++, $end++) if $Vi_mode;
-
- if ($point)
- {
- ## Not at the beginning of the line; Isolate the word to be completed.
- 1 while (--$point && (-1 == index($rl_completer_word_break_characters,
- substr($line, $point, 1))));
-
- # Either at beginning of line or at a word break.
- # If at a word break (that we don't want to save), skip it.
- $point++ if (
- (index($rl_completer_word_break_characters,
- substr($line, $point, 1)) != -1) &&
- (index($rl_special_prefixes, substr($line, $point, 1)) == -1)
- );
- }
-
- my $text = substr($line, $point, $end - $point);
- $rl_completer_terminator_character = ' ';
- @matches = &completion_matches($rl_completion_function,$text,$line,$point);
-
- if (@matches == 0) {
- return &F_Ding;
- } elsif ($what_to_do eq "\t") {
- my $replacement = shift(@matches);
- $replacement .= $rl_completer_terminator_character if @matches == 1;
- &F_Ding if @matches != 1;
- if ($var_TcshCompleteMode) {
- @tcsh_complete_selections = (@matches, $text);
- $tcsh_complete_start = $point;
- $tcsh_complete_len = length($replacement);
- }
- if ($replacement ne '') {
- substr($line, $point, $end-$point) = $replacement;
- $D = $D - ($end - $point) + length($replacement);
- }
- } elsif ($what_to_do eq '?') {
- shift(@matches); ## remove prepended common prefix
- local $\ = '';
- print $term_OUT "\n\r";
- # print "@matches\n\r";
- &pretty_print_list (@matches);
- $force_redraw = 1;
- } elsif ($what_to_do eq '*') {
- shift(@matches); ## remove common prefix.
- local $" = $rl_completer_terminator_character;
- my $replacement = "@matches$rl_completer_terminator_character";
- substr($line, $point, $end-$point) = $replacement; ## insert all.
- $D = $D - ($end - $point) + length($replacement);
- } else {
- warn "\r\n[Internal error]";
- return &F_Ding;
- }
-
- 1;
-}
-
-##
-## completion_matches(func, text, line, start)
-##
-## FUNC is a function to call as FUNC(TEXT, LINE, START)
-## where TEXT is the item to be completed
-## LINE is the whole command line, and
-## START is the starting index of TEXT in LINE.
-## The FUNC should return a list of items that might match.
-##
-## completion_matches will return that list, with the longest common
-## prefix prepended as the first item of the list. Therefor, the list
-## will either be of zero length (meaning no matches) or of 2 or more.....
-##
-
-## Works with &rl_basic_commands. Return items from @rl_basic_commands
-## that start with the pattern in $text.
-sub use_basic_commands {
- my ($text, $line, $start) = @_;
- return () if $start != 0;
- grep(/^$text/, @rl_basic_commands);
-}
-
-sub completion_matches
-{
- my ($func, $text, $line, $start) = @_;
-
- ## get the raw list
- my @matches;
-
- #print qq/\r\neval("\@matches = &$func(\$text, \$line, \$start)\n\r/;#DEBUG
- #eval("\@matches = &$func(\$text, \$line, \$start);1") || warn "$@ ";
- @matches = &$func($text, $line, $start);
-
- ## if anything returned , find the common prefix among them
- if (@matches) {
- my $prefix = $matches[0];
- my $len = length($prefix);
- for ($i = 1; $i < @matches; $i++) {
- next if substr($matches[$i], 0, $len) eq $prefix;
- $prefix = substr($prefix, 0, --$len);
- last if $len == 0;
- $i--; ## retry this one to see if the shorter one matches.
- }
- unshift(@matches, $prefix); ## make common prefix the first thing.
- }
- @matches;
-}
-
-##
-## For use in passing to completion_matches(), returns a list of
-## filenames that begin with the given pattern. The user of this package
-## can set $rl_completion_function to 'rl_filename_list' to restore the
-## default of filename matching if they'd changed it earlier, either
-## directly or via &rl_basic_commands.
-##
-sub rl_filename_list
-{
- my $pattern = $_[0];
- my @files = (<$pattern*>);
- if ($var_CompleteAddsuffix) {
- foreach (@files) {
- if (-l $_) {
- $_ .= '@';
- } elsif (-d _) {
- $_ .= '/';
- } elsif (-x _) {
- $_ .= '*';
- } elsif (-S _ || -p _) {
- $_ .= '=';
- }
- }
- }
- return @files;
-}
-
-##
-## For use by the user of the package. Called with a list of possible
-## commands, will allow command completion on those commands, but only
-## for the first word on a line.
-## For example: &rl_basic_commands('set', 'quit', 'type', 'run');
-##
-## This is for people that want quick and simple command completion.
-## A more thoughtful implementation would set $rl_completion_function
-## to a routine that would look at the context of the word being completed
-## and return the appropriate possibilities.
-##
-sub rl_basic_commands
-{
- @rl_basic_commands = @_;
- $rl_completion_function = 'use_basic_commands';
-}
-
-##
-## Print an array in columns like ls -C. Originally based on stuff
-## (lsC2.pl) by utashiro@sran230.sra.co.jp (Kazumasa Utashiro).
-##
-sub pretty_print_list
-{
- my @list = @_;
- return unless @list;
- my ($lines, $columns, $mark, $index);
-
- ## find width of widest entry
- my $maxwidth = 0;
- grep(length > $maxwidth && ($maxwidth = length), @list);
- $maxwidth++;
-
- $columns = $maxwidth >= $rl_screen_width
- ? 1 : int($rl_screen_width / $maxwidth);
-
- ## if there's enough margin to interspurse among the columns, do so.
- $maxwidth += int(($rl_screen_width % $maxwidth) / $columns);
-
- $lines = int((@list + $columns - 1) / $columns);
- $columns-- while ((($lines * $columns) - @list + 1) > $lines);
-
- $mark = $#list - $lines;
- local $\ = '';
- for ($l = 0; $l < $lines; $l++) {
- for ($index = $l; $index <= $mark; $index += $lines) {
- printf("%-$ {maxwidth}s", $list[$index]);
- }
- print $term_OUT $list[$index] if $index <= $#list;
- print $term_OUT "\n\r";
- }
-}
-
-##----------------- Vi Routines --------------------------------
-
-sub F_ViAcceptLine
-{
- &F_AcceptLine();
- &F_ViInput();
-}
-
-# Repeat the most recent one of these vi commands:
-#
-# a A c C d D i I p P r R s S x X ~
-#
-sub F_ViRepeatLastCommand {
- my($count) = @_;
- return &F_Ding if !$Last_vi_command;
-
- my @lastcmd = @$Last_vi_command;
-
- # Multiply @lastcmd's numeric arg by $count.
- unless ($count == 1) {
-
- my $n = '';
- while (@lastcmd and $lastcmd[0] =~ /^\d$/) {
- $n *= 10;
- $n += shift(@lastcmd);
- }
- $count *= $n unless $n eq '';
- unshift(@lastcmd, split(//, $count));
- }
-
- push(@Pending, @lastcmd);
-}
-
-sub F_ViMoveCursor
-{
- my($count, $ord) = @_;
-
- my $new_cursor = &get_position($count, $ord, undef, $Vi_move_patterns);
- return &F_Ding if !defined $new_cursor;
-
- $D = $new_cursor;
-}
-
-sub F_ViFindMatchingParens {
-
- # Move to the first parens at or after $D
- my $old_d = $D;
- &forward_scan(1, q/[^[\](){}]*/);
- my $parens = substr($line, $D, 1);
-
- my $mate_direction = {
- '(' => [ ')', 1 ],
- '[' => [ ']', 1 ],
- '{' => [ '}', 1 ],
- ')' => [ '(', -1 ],
- ']' => [ '[', -1 ],
- '}' => [ '{', -1 ],
-
- }->{$parens};
-
- return &F_Ding() unless $mate_direction;
-
- my($mate, $direction) = @$mate_direction;
-
- my $lvl = 1;
- while ($lvl) {
- last if !$D && ($direction < 0);
- &F_ForwardChar($direction);
- last if &at_end_of_line;
- my $c = substr($line, $D, 1);
- if ($c eq $parens) {
- $lvl++;
- }
- elsif ($c eq $mate) {
- $lvl--;
- }
- }
-
- if ($lvl) {
- # We didn't find a match
- $D = $old_d;
- return &F_Ding();
- }
-}
-
-sub F_ViForwardFindChar {
- &do_findchar(1, 1, @_);
-}
-
-sub F_ViBackwardFindChar {
- &do_findchar(-1, 0, @_);
-}
-
-sub F_ViForwardToChar {
- &do_findchar(1, 0, @_);
-}
-
-sub F_ViBackwardToChar {
- &do_findchar(-1, 1, @_);
-}
-
-sub F_ViMoveCursorTo
-{
- &do_findchar(1, -1, @_);
-}
-
-sub F_ViMoveCursorFind
-{
- &do_findchar(1, 0, @_);
-}
-
-
-sub F_ViRepeatFindChar {
- my($n) = @_;
- return &F_Ding if !defined $Last_findchar;
- &findchar(@$Last_findchar, $n);
-}
-
-sub F_ViInverseRepeatFindChar {
- my($n) = @_;
- return &F_Ding if !defined $Last_findchar;
- my($c, $direction, $offset) = @$Last_findchar;
- &findchar($c, -$direction, $offset, $n);
-}
-
-sub do_findchar {
- my($direction, $offset, $n) = @_;
- my $c = &getc_with_pending;
- $c = &getc_with_pending if $c eq "\cV";
- return &F_ViCommandMode if $c eq "\e";
- $Last_findchar = [$c, $direction, $offset];
- &findchar($c, $direction, $offset, $n);
-}
-
-sub findchar {
- my($c, $direction, $offset, $n) = @_;
- my $old_d = $D;
- while ($n) {
- last if !$D && ($direction < 0);
- &F_ForwardChar($direction);
- last if &at_end_of_line;
- my $char = substr($line, $D, 1);
- $n-- if substr($line, $D, 1) eq $c;
- }
- if ($n) {
- # Not found
- $D = $old_d;
- return &F_Ding;
- }
- &F_ForwardChar($offset);
-}
-
-sub F_ViMoveToColumn {
- my($n) = @_;
- $D = 0;
- my $col = 1;
- while (!&at_end_of_line and $col < $n) {
- my $c = substr($line, $D, 1);
- if ($c eq "\t") {
- $col += 7;
- $col -= ($col % 8) - 1;
- }
- else {
- $col++;
- }
- $D += &CharSize($D);
- }
-}
-
-sub start_dot_buf {
- my($count, $ord) = @_;
- $Dot_buf = [pack('c', $ord)];
- unshift(@$Dot_buf, split(//, $count)) if $count > 1;
- $Dot_state = savestate();
-}
-
-sub end_dot_buf {
- # We've recognized an editing command
-
- # Save the command keystrokes for use by '.'
- $Last_vi_command = $Dot_buf;
- undef $Dot_buf;
-
- # Save the pre-command state for use by 'u' and 'U';
- $Vi_undo_state = $Dot_state;
- $Vi_undo_all_state = $Dot_state if !$Vi_undo_all_state;
-
- # Make sure the current line is treated as new line for history purposes.
- $rl_HistoryIndex = $#rl_History + 1;
-}
-
-sub save_dot_buf {
- &start_dot_buf(@_);
- &end_dot_buf;
-}
-
-sub F_ViUndo {
- return &F_Ding unless defined $Vi_undo_state;
- my $state = savestate();
- &getstate($Vi_undo_state);
- $Vi_undo_state = $state;
-}
-
-sub F_ViUndoAll {
- $Vi_undo_state = $Vi_undo_all_state;
- &F_ViUndo;
-}
-
-sub F_ViChange
-{
- my($count, $ord) = @_;
- &start_dot_buf(@_);
- &do_delete($count, $ord, $Vi_change_patterns) || return();
- &vi_input_mode;
-}
-
-sub F_ViDelete
-{
- my($count, $ord) = @_;
- &start_dot_buf(@_);
- &do_delete($count, $ord, $Vi_delete_patterns);
- &end_dot_buf;
-}
-
-sub do_delete {
-
- my($count, $ord, $poshash) = @_;
-
- my $other_end = &get_position($count, undef, $ord, $poshash);
- return &F_Ding if !defined $other_end;
-
- if ($other_end < 0) {
- # dd - delete entire line
- &kill_text(0, length($line), 1);
- }
- else {
- &kill_text($D, $other_end, 1);
- }
-
- 1; # True return value
-}
-
-sub F_ViDeleteChar {
- my($count) = @_;
- &save_dot_buf(@_);
- my $other_end = $D + $count;
- $other_end = length($line) if $other_end > length($line);
- &kill_text($D, $other_end, 1);
-}
-
-sub F_ViBackwardDeleteChar {
- my($count) = @_;
- &save_dot_buf(@_);
- my $other_end = $D - $count;
- $other_end = 0 if $other_end < 0;
- &kill_text($other_end, $D, 1);
- $D = $other_end;
-}
-
-##
-## Prepend line with '#', add to history, and clear the input buffer
-## (this feature was borrowed from ksh).
-##
-sub F_SaveLine
-{
- local $\ = '';
- $line = '#'.$line;
- &redisplay();
- print $term_OUT "\r\n";
- &add_line_to_history;
- $line_for_revert = '';
- &get_line_from_history(scalar @rl_History);
- &F_ViInput() if $Vi_mode;
-}
-
-#
-# Come here if we see a non-positioning keystroke when a positioning
-# keystroke is expected.
-#
-sub F_ViNonPosition {
- # Not a positioning command - undefine the cursor to indicate the error
- # to get_position().
- undef $D;
-}
-
-#
-# Come here if we see <esc><char>, but *not* an arrow key or other
-# mapped sequence, when a positioning keystroke is expected.
-#
-sub F_ViPositionEsc {
- my($count, $ord) = @_;
-
- # We got <esc><char> in vipos mode. Put <char> back onto the
- # input stream and terminate the positioning command.
- unshift(@Pending, pack('c', $ord));
- &F_ViNonPosition;
-}
-
-# Interpret vi positioning commands
-sub get_position {
- my ($count, $ord, $fullline_ord, $poshash) = @_;
-
- # Manipulate a copy of the cursor, not the real thing
- local $D = $D;
-
- # $ord (first character of positioning command) is an optional argument.
- $ord = ord(&getc_with_pending) if !defined $ord;
-
- # Detect double character (for full-line operation, e.g. dd)
- return -1 if defined $fullline_ord and $ord == $fullline_ord;
-
- my $re = $poshash->{$ord};
-
- if ($re) {
- my $c = pack('c', $ord);
- if (lc($c) eq 'b') {
- &backward_scan($count, $re);
- }
- else {
- &forward_scan($count, $re);
- }
- }
- else {
- # Move the local copy of the cursor
- &do_command($var_EditingMode{'vipos'}, $count, $ord);
- }
-
- # Return the new cursor (undef if illegal command)
- $D;
-}
-
-##
-## Go to first non-space character of line.
-##
-sub F_ViFirstWord
-{
- $D = 0;
- &forward_scan(1, q{\s+});
-}
-
-sub forward_scan {
- my($count, $re) = @_;
- while ($count--) {
- last unless substr($line, $D) =~ m{^($re)};
- $D += length($1);
- }
-}
-
-sub backward_scan {
- my($count, $re) = @_;
- while ($count--) {
- last unless substr($line, 0, $D) =~ m{($re)$};
- $D -= length($1);
- }
-}
-
-# Note: like the emacs case transforms, this doesn't work for
-# two-byte characters.
-sub F_ViToggleCase {
- my($count) = @_;
- &save_dot_buf(@_);
- while ($count-- > 0) {
- substr($line, $D, 1) =~ tr/A-Za-z/a-zA-Z/;
- &F_ForwardChar(1);
- if (&at_end_of_line) {
- &F_BackwardChar(1);
- last;
- }
- }
-}
-
-# Go to the numbered history line, as listed by the 'H' command, i.e. the
-# current $line is line 1, the youngest line in @rl_History is 2, etc.
-sub F_ViHistoryLine {
- my($n) = @_;
- &get_line_from_history(@rl_History - $n + 1);
-}
-
-sub get_line_from_history {
- my($n) = @_;
- return &F_Ding if $n < 0 or $n > @rl_History;
- return if $n == $rl_HistoryIndex;
-
- # If we're moving from the currently-edited line, save it for later.
- $line_for_revert = $line if $rl_HistoryIndex == @rl_History;
-
- # Get line from history buffer (or from saved edit line).
- $line = ($n == @rl_History) ? $line_for_revert : $rl_History[$n];
- $D = $Vi_mode ? 0 : length $line;
-
- # Subsequent 'U' will bring us back to this point.
- $Vi_undo_all_state = savestate() if $Vi_mode;
-
- $rl_HistoryIndex = $n;
-}
-
-sub F_PrintHistory {
- my($count) = @_;
-
- $count = 20 if $count == 1; # Default - assume 'H', not '1H'
- my $end = $rl_HistoryIndex + $count/2;
- $end = @rl_History if $end > @rl_History;
- my $start = $end - $count + 1;
- $start = 0 if $start < 0;
-
- my $lmh = length $rl_MaxHistorySize;
-
- my $lspace = ' ' x ($lmh+3);
- my $hdr = "$lspace-----";
- $hdr .= " (Use ESC <num> UP to retrieve command <num>) -----" unless $Vi_mode;
- $hdr .= " (Use '<num>G' to retrieve command <num>) -----" if $Vi_mode;
-
- local ($\, $,) = ('','');
- print "\n$hdr\n";
- print $lspace, ". . .\n" if $start > 0;
- my $i;
- my $shift = ($Vi_mode != 0);
- for $i ($start .. $end) {
- print + ($i == $rl_HistoryIndex) ? '>' : ' ',
-
- sprintf("%${lmh}d: ", @rl_History - $i + $shift),
-
- ($i < @rl_History) ? $rl_History[$i] :
- ($i == $rl_HistoryIndex) ? $line :
- $line_for_revert,
-
- "\n";
- }
- print $lspace, ". . .\n" if $end < @rl_History;
- print "$hdr\n";
-
- &force_redisplay();
-
- &F_ViInput() if $line eq '' && $Vi_mode;
-}
-
-# Redisplay the line, without attempting any optimization
-sub force_redisplay {
- local $force_redraw = 1;
- &redisplay(@_);
-}
-
-# Search history for matching string. As with vi in nomagic mode, the
-# ^, $, \<, and \> positional assertions, the \* quantifier, the \.
-# character class, and the \[ character class delimiter all have special
-# meaning here.
-sub F_ViSearch {
- my($n, $ord) = @_;
-
- my $c = pack('c', $ord);
-
- my $str = &get_vi_search_str($c);
- if (!defined $str) {
- # Search aborted by deleting the '/' at the beginning of the line
- return &F_ViInput() if $line eq '';
- return();
- }
-
- # Null string repeats last search
- if ($str eq '') {
- return &F_Ding unless defined $Vi_search_re;
- }
- else {
- # Convert to a regular expression. Interpret $str Like vi in nomagic
- # mode: '^', '$', '\<', and '\>' positional assertions, '\*'
- # quantifier, '\.' and '\[]' character classes.
-
- my @chars = ($str =~ m{(\\?.)}g);
- my(@re, @tail);
- unshift(@re, shift(@chars)) if @chars and $chars[0] eq '^';
- push (@tail, pop(@chars)) if @chars and $chars[-1] eq '$';
- my $in_chclass;
- my %chmap = (
- '\<' => '\b(?=\w)',
- '\>' => '(?<=\w)\b',
- '\*' => '*',
- '\[' => '[',
- '\.' => '.',
- );
- my $ch;
- foreach $ch (@chars) {
- if ($in_chclass) {
- # Any backslashes in vi char classes are literal
- push(@re, "\\") if length($ch) > 1;
- push(@re, $ch);
- $in_chclass = 0 if $ch =~ /\]$/;
- }
- else {
- push(@re, (length $ch == 2) ? ($chmap{$ch} || $ch) :
- ($ch =~ /^\w$/) ? $ch :
- ("\\", $ch));
- $in_chclass = 1 if $ch eq '\[';
- }
- }
- my $re = join('', @re, @tail);
- $Vi_search_re = q{$re};
- }
-
- local $reverse = $Vi_search_reverse = ($c eq '/') ? 1 : 0;
- &do_vi_search();
-}
-
-sub F_ViRepeatSearch {
- my($n, $ord) = @_;
- my $c = pack('c', $ord);
- return &F_Ding unless defined $Vi_search_re;
- local $reverse = $Vi_search_reverse;
- $reverse ^= 1 if $c eq 'N';
- &do_vi_search();
-}
-
-## returns a new $i or -1 if not found.
-sub vi_search {
- my ($i) = @_;
- return -1 if $i < 0 || $i > $#rl_History; ## for safety
- while (1) {
- return $i if $rl_History[$i] =~ /$Vi_search_re/;
- if ($reverse) {
- return -1 if $i-- == 0;
- } else {
- return -1 if $i++ == $#rl_History;
- }
- }
-}
-
-sub do_vi_search {
- my $incr = $reverse ? -1 : 1;
-
- my $i = &vi_search($rl_HistoryIndex + $incr);
- return &F_Ding if $i < 0; # Not found.
-
- $rl_HistoryIndex = $i;
- ($D, $line) = (0, $rl_History[$rl_HistoryIndex]);
-}
-
-# Using local $line, $D, and $prompt, get and return the string to search for.
-sub get_vi_search_str {
- my($c) = @_;
-
- local $prompt = $prompt . $c;
- local ($line, $D) = ('', 0);
- &redisplay();
-
- # Gather a search string in our local $line.
- while ($lastcommand ne 'F_ViEndSearch') {
- &do_command($var_EditingMode{'visearch'}, 1, ord(&getc_with_pending));
- &redisplay();
-
- # We've backspaced past beginning of line
- return undef if !defined $line;
- }
- $line;
-}
-
-sub F_ViEndSearch {}
-
-sub F_ViSearchBackwardDeleteChar {
- if ($line eq '') {
- # Backspaced past beginning of line - terminate search mode
- undef $line;
- }
- else {
- &F_BackwardDeleteChar(@_);
- }
-}
-
-##
-## Kill entire line and enter input mode
-##
-sub F_ViChangeEntireLine
-{
- &start_dot_buf(@_);
- kill_text(0, length($line), 1);
- &vi_input_mode;
-}
-
-##
-## Kill characters and enter input mode
-##
-sub F_ViChangeChar
-{
- &start_dot_buf(@_);
- &F_DeleteChar(@_);
- &vi_input_mode;
-}
-
-sub F_ViReplaceChar
-{
- &start_dot_buf(@_);
- my $c = &getc_with_pending;
- $c = &getc_with_pending if $c eq "\cV"; # ctrl-V
- return &F_ViCommandMode if $c eq "\e";
- &end_dot_buf;
-
- local $InsertMode = 0;
- local $D = $D; # Preserve cursor position
- &F_SelfInsert(1, ord($c));
-}
-
-##
-## Kill from cursor to end of line and enter input mode
-##
-sub F_ViChangeLine
-{
- &start_dot_buf(@_);
- &F_KillLine(@_);
- &vi_input_mode;
-}
-
-sub F_ViDeleteLine
-{
- &save_dot_buf(@_);
- &F_KillLine(@_);
-}
-
-sub F_ViPut
-{
- my($count) = @_;
- &save_dot_buf(@_);
- my $text2add = $KillBuffer x $count;
- my $ll = length($line);
- $D++;
- $D = $ll if $D > $ll;
- substr($line, $D, 0) = $KillBuffer x $count;
- $D += length($text2add) - 1;
-}
-
-sub F_ViPutBefore
-{
- &save_dot_buf(@_);
- &TextInsert($_[0], $KillBuffer);
-}
-
-sub F_ViYank
-{
- my($count, $ord) = @_;
- my $pos = &get_position($count, undef, $ord, $Vi_yank_patterns);
- &F_Ding if !defined $pos;
- if ($pos < 0) {
- # yy
- &F_ViYankLine;
- }
- else {
- my($from, $to) = ($pos > $D) ? ($D, $pos) : ($pos, $D);
- $KillBuffer = substr($line, $from, $to-$from);
- }
-}
-
-sub F_ViYankLine
-{
- $KillBuffer = $line;
-}
-
-sub F_ViInput
-{
- @_ = (1, ord('i')) if !@_;
- &start_dot_buf(@_);
- &vi_input_mode;
-}
-
-sub F_ViBeginInput
-{
- &start_dot_buf(@_);
- &F_BeginningOfLine;
- &vi_input_mode;
-}
-
-sub F_ViReplaceMode
-{
- &start_dot_buf(@_);
- $InsertMode = 0;
- $var_EditingMode = $var_EditingMode{'vi'};
- $Vi_mode = 1;
-}
-
-sub vi_input_mode
-{
- $InsertMode = 1;
- $var_EditingMode = $var_EditingMode{'vi'};
- $Vi_mode = 1;
-}
-
-# The previous keystroke was an escape, but the sequence was not recognized
-# as a mapped sequence (like an arrow key). Enter vi comand mode and
-# process this keystroke.
-sub F_ViAfterEsc {
- my($n, $ord) = @_;
- &F_ViCommandMode;
- &do_command($var_EditingMode, 1, $ord);
-}
-
-sub F_ViAppend
-{
- &start_dot_buf(@_);
- &vi_input_mode;
- &F_ForwardChar;
-}
-
-sub F_ViAppendLine
-{
- &start_dot_buf(@_);
- &vi_input_mode;
- &F_EndOfLine;
-}
-
-sub F_ViCommandMode
-{
- $var_EditingMode = $var_EditingMode{'vicmd'};
- $Vi_mode = 1;
-}
-
-sub F_ViAcceptInsert {
- local $in_accept_line = 1;
- &F_ViEndInsert;
- &F_ViAcceptLine;
-}
-
-sub F_ViEndInsert
-{
- if ($Dot_buf) {
- if ($line eq '' and $Dot_buf->[0] eq 'i') {
- # We inserted nothing into an empty $line - assume it was a
- # &F_ViInput() call with no arguments, and don't save command.
- undef $Dot_buf;
- }
- else {
- # Regardless of which keystroke actually terminated this insert
- # command, replace it with an <esc> in the dot buffer.
- @{$Dot_buf}[-1] = "\e";
- &end_dot_buf;
- }
- }
- &F_ViCommandMode;
- # Move cursor back to the last inserted character, but not when
- # we're about to accept a line of input
- &F_BackwardChar(1) unless $in_accept_line;
-}
-
-sub F_ViDigit {
- my($count, $ord) = @_;
-
- my $n = 0;
- my $ord0 = ord('0');
- while (1) {
-
- $n *= 10;
- $n += $ord - $ord0;
-
- my $c = &getc_with_pending;
- return unless defined $c;
- $ord = ord($c);
- last unless $c =~ /^\d$/;
- }
-
- $n *= $count; # So 2d3w deletes six words
- $n = $rl_max_numeric_arg if $n > $rl_max_numeric_arg;
-
- &do_command($var_EditingMode, $n, $ord);
-}
-
-sub F_ViComplete {
- my($n, $ord) = @_;
-
- $Dot_state = savestate(); # Completion is undo-able
- undef $Dot_buf; # but not redo-able
-
- my $ch;
- while (1) {
-
- &F_Complete() or return;
-
- # Vi likes the cursor one character right of where emacs like it.
- &F_ForwardChar(1);
- &force_redisplay();
-
- # Look ahead to the next input keystroke.
- $ch = &getc_with_pending();
- last unless ord($ch) == $ord; # Not a '\' - quit.
-
- # Another '\' was typed - put the cursor back where &F_Complete left
- # it, and try again.
- &F_BackwardChar(1);
- $lastcommand = 'F_Complete'; # Play along with &F_Complete's kludge
- }
- unshift(@Pending, $ch); # Unget the lookahead keystroke
-
- # Successful completion - enter input mode with cursor beyond end of word.
- &vi_input_mode;
-}
-
-sub F_ViInsertPossibleCompletions {
- $Dot_state = savestate(); # Completion is undo-able
- undef $Dot_buf; # but not redo-able
-
- &complete_internal('*') or return;
-
- # Successful completion - enter input mode with cursor beyond end of word.
- &F_ForwardChar(1);
- &vi_input_mode;
-}
-
-sub F_ViPossibleCompletions {
-
- # List possible completions
- &complete_internal('?');
-
- # Enter input mode with cursor where we left off.
- &F_ForwardChar(1);
- &vi_input_mode;
-}
-
-sub F_SetMark {
- $rl_mark = $D;
- pos $line = $rl_mark;
- $line_rl_mark = $rl_HistoryIndex;
- $force_redraw = 1;
-}
-
-sub F_ExchangePointAndMark {
- return F_Ding unless $line_rl_mark == $rl_HistoryIndex;
- ($rl_mark, $D) = ($D, $rl_mark);
- pos $line = $rl_mark;
- $D = length $line if $D > length $line;
- $force_redraw = 1;
-}
-
-sub F_KillRegion {
- return F_Ding unless $line_rl_mark == $rl_HistoryIndex;
- $rl_mark = length $line if $rl_mark > length $line;
- kill_text($rl_mark, $D, 1);
- $line_rl_mark = -1; # Disable mark
-}
-
-sub F_CopyRegionAsKill {
- return F_Ding unless $line_rl_mark == $rl_HistoryIndex;
- $rl_mark = length $line if $rl_mark > length $line;
- my ($s, $e) = ($rl_mark, $D);
- ($s, $e) = ($e, $s) if $s > $e;
- $ThisCommandKilledText = 1 + $s;
- $KillBuffer = '' if !$LastCommandKilledText;
- $KillBuffer .= substr($line, $s, $e - $s);
-}
-
-sub clipboard_set {
- my $in = shift;
- if ($^O eq 'os2') {
- eval {
- require OS2::Process;
- OS2::Process::ClipbrdText_set($in); # Do not disable \r\n-conversion
- 1
- } and return;
- } elsif ($^O eq 'MSWin32') {
- eval {
- require Win32::Clipboard;
- Win32::Clipboard::Set($in);
- 1
- } and return;
- }
- my $mess;
- if ($ENV{RL_CLCOPY_CMD}) {
- $mess = "Writing to pipe `$ENV{RL_CLCOPY_CMD}'";
- open COPY, "| $ENV{RL_CLCOPY_CMD}" or warn("$mess: $!"), return;
- } elsif (defined $ENV{HOME}) {
- $mess = "Writing to file `$ENV{HOME}/.rl_cutandpaste'";
- open COPY, "> $ENV{HOME}/.rl_cutandpaste" or warn("$mess: $!"), return;
- } else {
- return;
- }
- print COPY $in;
- close COPY or warn("$mess: closing $!");
-}
-
-sub F_CopyRegionAsKillClipboard {
- return clipboard_set($line) unless $line_rl_mark == $rl_HistoryIndex;
- &F_CopyRegionAsKill;
- clipboard_set($KillBuffer);
-}
-
-sub F_KillRegionClipboard {
- &F_KillRegion;
- clipboard_set($KillBuffer);
-}
-
-sub F_YankClipboard
-{
- remove_selection();
- my $in;
- if ($^O eq 'os2') {
- eval {
- require OS2::Process;
- $in = OS2::Process::ClipbrdText();
- $in =~ s/\r\n/\n/g; # With old versions, or what?
- }
- } elsif ($^O eq 'MSWin32') {
- eval {
- require Win32::Clipboard;
- $in = Win32::Clipboard::GetText();
- $in =~ s/\r\n/\n/g; # is this needed?
- }
- } else {
- my $mess;
- if ($ENV{RL_PASTE_CMD}) {
- $mess = "Reading from pipe `$ENV{RL_PASTE_CMD}'";
- open PASTE, "$ENV{RL_PASTE_CMD} |" or warn("$mess: $!"), return;
- } elsif (defined $ENV{HOME}) {
- $mess = "Reading from file `$ENV{HOME}/.rl_cutandpaste'";
- open PASTE, "< $ENV{HOME}/.rl_cutandpaste" or warn("$mess: $!"), return;
- }
- if ($mess) {
- local $/;
- $in = <PASTE>;
- close PASTE or warn("$mess, closing: $!");
- }
- }
- if (defined $in) {
- $in =~ s/\n+$//;
- return &TextInsert($_[0], $in);
- }
- &TextInsert($_[0], $KillBuffer);
-}
-
-sub F_BeginUndoGroup {
- push @undoGroupS, $#undo;
-}
-
-sub F_EndUndoGroup {
- return F_Ding unless @undoGroupS;
- my $last = pop @undoGroupS;
- return unless $#undo > $last + 1;
- my $now = pop @undo;
- $#undo = $last;
- push @undo, $now;
-}
-
-sub F_DoNothing { # E.g., reset digit-argument
- 1;
-}
-
-sub F_ForceMemorizeDigitArgument {
- $memorizedArg = shift;
-}
-
-sub F_MemorizeDigitArgument {
- return if defined $memorizedArg;
- $memorizedArg = shift;
-}
-
-sub F_UnmemorizeDigitArgument {
- $memorizedArg = undef;
-}
-
-sub F_MemorizePos {
- $memorizedPos = $D;
-}
-
-# It is assumed that F_MemorizePos was called, then something was inserted,
-# then F_MergeInserts is called with a prefix argument to multiply
-# insertion by
-
-sub F_MergeInserts {
- my $n = shift;
- return F_Ding unless defined $memorizedPos and $n > 0;
- my ($b, $e) = ($memorizedPos, $D);
- ($b, $e) = ($e, $b) if $e < $b;
- if ($n) {
- substr($line, $e, 0) = substr($line, $b, $e - $b) x ($n - 1);
- } else {
- substr($line, $b, $e - $b) = '';
- }
- $D = $b + ($e - $b) * $n;
-}
-
-sub F_ResetDigitArgument {
- return F_Ding unless defined $memorizedArg;
- my $in = &getc_with_pending;
- return unless defined $in;
- my $ord = ord $in;
- local(*KeyMap) = $var_EditingMode;
- &do_command(*KeyMap, $memorizedArg, $ord);
-}
-
-sub F_BeginPasteGroup {
- my $c = shift;
- $memorizedArg = $c unless defined $memorizedArg;
- F_BeginUndoGroup(1);
- $memorizedPos = $D;
-}
-
-sub F_EndPasteGroup {
- my $c = $memorizedArg;
- undef $memorizedArg;
- $c = 1 unless defined $c;
- F_MergeInserts($c);
- F_EndUndoGroup(1);
-}
-
-sub F_BeginEditGroup {
- $memorizedArg = shift;
- F_BeginUndoGroup(1);
-}
-
-sub F_EndEditGroup {
- undef $memorizedArg;
- F_EndUndoGroup(1);
-}
-
-1;
-__END__
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Test/Pod.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Test/Pod.pm
deleted file mode 100644
index dc01bf3351b..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Test/Pod.pm
+++ /dev/null
@@ -1,270 +0,0 @@
-package Test::Pod;
-
-use strict;
-
-=head1 NAME
-
-Test::Pod - check for POD errors in files
-
-=head1 VERSION
-
-Version 1.26
-
-=cut
-
-use vars qw( $VERSION );
-$VERSION = '1.26';
-
-=head1 SYNOPSIS
-
-C<Test::Pod> lets you check the validity of a POD file, and report
-its results in standard C<Test::Simple> fashion.
-
- use Test::Pod tests => $num_tests;
- pod_file_ok( $file, "Valid POD file" );
-
-Module authors can include the following in a F<t/pod.t> file and
-have C<Test::Pod> automatically find and check all POD files in a
-module distribution:
-
- use Test::More;
- eval "use Test::Pod 1.00";
- plan skip_all => "Test::Pod 1.00 required for testing POD" if $@;
- all_pod_files_ok();
-
-You can also specify a list of files to check, using the
-C<all_pod_files()> function supplied:
-
- use strict;
- use Test::More;
- eval "use Test::Pod 1.00";
- plan skip_all => "Test::Pod 1.00 required for testing POD" if $@;
- my @poddirs = qw( blib script );
- all_pod_files_ok( all_pod_files( @poddirs ) );
-
-Or even (if you're running under L<Apache::Test>):
-
- use strict;
- use Test::More;
- eval "use Test::Pod 1.00";
- plan skip_all => "Test::Pod 1.00 required for testing POD" if $@;
-
- my @poddirs = qw( blib script );
- use File::Spec::Functions qw( catdir updir );
- all_pod_files_ok(
- all_pod_files( map { catdir updir, $_ } @poddirs )
- );
-
-=head1 DESCRIPTION
-
-Check POD files for errors or warnings in a test file, using
-C<Pod::Simple> to do the heavy lifting.
-
-=cut
-
-use 5.004;
-
-use Pod::Simple;
-use Test::Builder;
-use File::Spec;
-
-my $Test = Test::Builder->new;
-
-sub import {
- my $self = shift;
- my $caller = caller;
-
- for my $func ( qw( pod_file_ok all_pod_files all_pod_files_ok ) ) {
- no strict 'refs';
- *{$caller."::".$func} = \&$func;
- }
-
- $Test->exported_to($caller);
- $Test->plan(@_);
-}
-
-=head1 FUNCTIONS
-
-=head2 pod_file_ok( FILENAME[, TESTNAME ] )
-
-C<pod_file_ok()> will okay the test if the POD parses correctly. Certain
-conditions are not reported yet, such as a file with no pod in it at all.
-
-When it fails, C<pod_file_ok()> will show any pod checking errors as
-diagnostics.
-
-The optional second argument TESTNAME is the name of the test. If it
-is omitted, C<pod_file_ok()> chooses a default test name "POD test
-for FILENAME".
-
-=cut
-
-sub pod_file_ok {
- my $file = shift;
- my $name = @_ ? shift : "POD test for $file";
-
- if ( !-f $file ) {
- $Test->ok( 0, $name );
- $Test->diag( "$file does not exist" );
- return;
- }
-
- my $checker = Pod::Simple->new;
-
- $checker->output_string( \my $trash ); # Ignore any output
- $checker->parse_file( $file );
-
- my $ok = !$checker->any_errata_seen;
- $Test->ok( $ok, $name );
- if ( !$ok ) {
- my $lines = $checker->{errata};
- for my $line ( sort { $a<=>$b } keys %$lines ) {
- my $errors = $lines->{$line};
- $Test->diag( "$file ($line): $_" ) for @$errors;
- }
- }
-
- return $ok;
-} # pod_file_ok
-
-=head2 all_pod_files_ok( [@files/@directories] )
-
-Checks all the files in C<@files> for valid POD. It runs
-L<all_pod_files()> on each file/directory, and calls the C<plan()> function for you
-(one test for each function), so you can't have already called C<plan>.
-
-If C<@files> is empty or not passed, the function finds all POD files in
-the F<blib> directory if it exists, or the F<lib> directory if not.
-A POD file is one that ends with F<.pod>, F<.pl> and F<.pm>, or any file
-where the first line looks like a shebang line.
-
-If you're testing a module, just make a F<t/pod.t>:
-
- use Test::More;
- eval "use Test::Pod 1.00";
- plan skip_all => "Test::Pod 1.00 required for testing POD" if $@;
- all_pod_files_ok();
-
-Returns true if all pod files are ok, or false if any fail.
-
-=cut
-
-sub all_pod_files_ok {
- my @files = @_ ? @_ : all_pod_files();
-
- $Test->plan( tests => scalar @files );
-
- my $ok = 1;
- foreach my $file ( @files ) {
- pod_file_ok( $file, $file ) or undef $ok;
- }
- return $ok;
-}
-
-=head2 all_pod_files( [@dirs] )
-
-Returns a list of all the Perl files in I<$dir> and in directories below.
-If no directories are passed, it defaults to F<blib> if F<blib> exists,
-or else F<lib> if not. Skips any files in CVS or .svn directories.
-
-A Perl file is:
-
-=over 4
-
-=item * Any file that ends in F<.PL>, F<.pl>, F<.pm>, F<.pod> or F<.t>.
-
-=item * Any file that has a first line with a shebang and "perl" on it.
-
-=back
-
-The order of the files returned is machine-dependent. If you want them
-sorted, you'll have to sort them yourself.
-
-=cut
-
-sub all_pod_files {
- my @queue = @_ ? @_ : _starting_points();
- my @pod = ();
-
- while ( @queue ) {
- my $file = shift @queue;
- if ( -d $file ) {
- local *DH;
- opendir DH, $file or next;
- my @newfiles = readdir DH;
- closedir DH;
-
- @newfiles = File::Spec->no_upwards( @newfiles );
- @newfiles = grep { $_ ne "CVS" && $_ ne ".svn" } @newfiles;
-
- foreach my $newfile (@newfiles) {
- my $filename = File::Spec->catfile( $file, $newfile );
- if ( -f $filename ) {
- push @queue, $filename;
- }
- else {
- push @queue, File::Spec->catdir( $file, $newfile );
- }
- }
- }
- if ( -f $file ) {
- push @pod, $file if _is_perl( $file );
- }
- } # while
- return @pod;
-}
-
-sub _starting_points {
- return 'blib' if -e 'blib';
- return 'lib';
-}
-
-sub _is_perl {
- my $file = shift;
-
- return 1 if $file =~ /\.PL$/;
- return 1 if $file =~ /\.p(l|m|od)$/;
- return 1 if $file =~ /\.t$/;
-
- local *FH;
- open FH, $file or return;
- my $first = <FH>;
- close FH;
-
- return 1 if defined $first && ($first =~ /^#!.*perl/);
-
- return;
-}
-
-=head1 TODO
-
-STUFF TO DO
-
-Note the changes that are being made.
-
-Note that you no longer can test for "no pod".
-
-=head1 AUTHOR
-
-Currently maintained by Andy Lester, C<< <andy at petdance.com> >>.
-
-Originally by brian d foy.
-
-=head1 ACKNOWLEDGEMENTS
-
-Thanks to
-David Wheeler
-and
-Peter Edwards
-for contributions and to C<brian d foy> for the original code.
-
-=head1 COPYRIGHT
-
-Copyright 2006, Andy Lester, All Rights Reserved.
-
-You may use, modify, and distribute this package under the
-same terms as Perl itself.
-
-=cut
-
-1;
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Test/Pod/Coverage.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Test/Pod/Coverage.pm
deleted file mode 100644
index fee0eb46aaf..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Test/Pod/Coverage.pm
+++ /dev/null
@@ -1,305 +0,0 @@
-package Test::Pod::Coverage;
-
-=head1 NAME
-
-Test::Pod::Coverage - Check for pod coverage in your distribution.
-
-=head1 VERSION
-
-Version 1.08
-
-=cut
-
-our $VERSION = "1.08";
-
-=head1 SYNOPSIS
-
-Checks for POD coverage in files for your distribution.
-
- use Test::Pod::Coverage tests=>1;
- pod_coverage_ok( "Foo::Bar", "Foo::Bar is covered" );
-
-Can also be called with L<Pod::Coverage> parms.
-
- use Test::Pod::Coverage tests=>1;
- pod_coverage_ok(
- "Foo::Bar",
- { also_private => [ qr/^[A-Z_]+$/ ], },
- "Foo::Bar, with all-caps functions as privates",
- );
-
-The L<Pod::Coverage> parms are also useful for subclasses that don't
-re-document the parent class's methods. Here's an example from
-L<Mail::SRS>.
-
- pod_coverage_ok( "Mail::SRS" ); # No exceptions
-
- # Define the three overridden methods.
- my $trustme = { trustme => [qr/^(new|parse|compile)$/] };
- pod_coverage_ok( "Mail::SRS::DB", $trustme );
- pod_coverage_ok( "Mail::SRS::Guarded", $trustme );
- pod_coverage_ok( "Mail::SRS::Reversable", $trustme );
- pod_coverage_ok( "Mail::SRS::Shortcut", $trustme );
-
-Alternately, you could use L<Pod::Coverage::CountParents>, which always allows
-a subclass to reimplement its parents' methods without redocumenting them. For
-example:
-
- my $trustparents = { coverage_class => 'Pod::Coverage::CountParents' };
- pod_coverage_ok( "IO::Handle::Frayed", $trustparents );
-
-(The C<coverage_class> parameter is not passed to the coverage class with other
-parameters.)
-
-If you want POD coverage for your module, but don't want to make
-Test::Pod::Coverage a prerequisite for installing, create the following
-as your F<t/pod-coverage.t> file:
-
- use Test::More;
- eval "use Test::Pod::Coverage";
- plan skip_all => "Test::Pod::Coverage required for testing pod coverage" if $@;
-
- plan tests => 1;
- pod_coverage_ok( "Pod::Master::Html");
-
-Finally, Module authors can include the following in a F<t/pod-coverage.t>
-file and have C<Test::Pod::Coverage> automatically find and check all
-modules in the module distribution:
-
- use Test::More;
- eval "use Test::Pod::Coverage 1.00";
- plan skip_all => "Test::Pod::Coverage 1.00 required for testing POD coverage" if $@;
- all_pod_coverage_ok();
-
-=cut
-
-use strict;
-use warnings;
-
-use Pod::Coverage;
-use Test::Builder;
-
-my $Test = Test::Builder->new;
-
-sub import {
- my $self = shift;
- my $caller = caller;
- no strict 'refs';
- *{$caller.'::pod_coverage_ok'} = \&pod_coverage_ok;
- *{$caller.'::all_pod_coverage_ok'} = \&all_pod_coverage_ok;
- *{$caller.'::all_modules'} = \&all_modules;
-
- $Test->exported_to($caller);
- $Test->plan(@_);
-}
-
-=head1 FUNCTIONS
-
-All functions listed below are exported to the calling namespace.
-
-=head2 all_pod_coverage_ok( [$parms, ] $msg )
-
-Checks that the POD code in all modules in the distro have proper POD
-coverage.
-
-If the I<$parms> hashref if passed in, they're passed into the
-C<Pod::Coverage> object that the function uses. Check the
-L<Pod::Coverage> manual for what those can be.
-
-The exception is the C<coverage_class> parameter, which specifies a class to
-use for coverage testing. It defaults to C<Pod::Coverage>.
-
-=cut
-
-sub all_pod_coverage_ok {
- my $parms = (@_ && (ref $_[0] eq "HASH")) ? shift : {};
- my $msg = shift;
-
- my $ok = 1;
- my @modules = all_modules();
- if ( @modules ) {
- $Test->plan( tests => scalar @modules );
-
- for my $module ( @modules ) {
- my $thismsg = defined $msg ? $msg : "Pod coverage on $module";
-
- my $thisok = pod_coverage_ok( $module, $parms, $thismsg );
- $ok = 0 unless $thisok;
- }
- }
- else {
- $Test->plan( tests => 1 );
- $Test->ok( 1, "No modules found." );
- }
-
- return $ok;
-}
-
-
-=head2 pod_coverage_ok( $module, [$parms, ] $msg )
-
-Checks that the POD code in I<$module> has proper POD coverage.
-
-If the I<$parms> hashref if passed in, they're passed into the
-C<Pod::Coverage> object that the function uses. Check the
-L<Pod::Coverage> manual for what those can be.
-
-The exception is the C<coverage_class> parameter, which specifies a class to
-use for coverage testing. It defaults to C<Pod::Coverage>.
-
-=cut
-
-sub pod_coverage_ok {
- my $module = shift;
- my %parms = (@_ && (ref $_[0] eq "HASH")) ? %{(shift)} : ();
- my $msg = @_ ? shift : "Pod coverage on $module";
-
- my $pc_class = (delete $parms{coverage_class}) || 'Pod::Coverage';
- eval "require $pc_class" or die $@;
-
- my $pc = $pc_class->new( package => $module, %parms );
-
- my $rating = $pc->coverage;
- my $ok;
- if ( defined $rating ) {
- $ok = ($rating == 1);
- $Test->ok( $ok, $msg );
- if ( !$ok ) {
- my @nakies = sort $pc->naked;
- my $s = @nakies == 1 ? "" : "s";
- $Test->diag(
- sprintf( "Coverage for %s is %3.1f%%, with %d naked subroutine$s:",
- $module, $rating*100, scalar @nakies ) );
- $Test->diag( "\t$_" ) for @nakies;
- }
- }
- else { # No symbols
- my $why = $pc->why_unrated;
- my $nopublics = ( $why =~ "no public symbols defined" );
- my $verbose = $ENV{HARNESS_VERBOSE} || 0;
- $ok = $nopublics;
- $Test->ok( $ok, $msg );
- $Test->diag( "$module: $why" ) unless ( $nopublics && !$verbose );
- }
-
- return $ok;
-}
-
-=head2 all_modules( [@dirs] )
-
-Returns a list of all modules in I<$dir> and in directories below. If
-no directories are passed, it defaults to F<blib> if F<blib> exists,
-or F<lib> if not.
-
-Note that the modules are as "Foo::Bar", not "Foo/Bar.pm".
-
-The order of the files returned is machine-dependent. If you want them
-sorted, you'll have to sort them yourself.
-
-=cut
-
-sub all_modules {
- my @starters = @_ ? @_ : _starting_points();
- my %starters = map {$_,1} @starters;
-
- my @queue = @starters;
-
- my @modules;
- while ( @queue ) {
- my $file = shift @queue;
- if ( -d $file ) {
- local *DH;
- opendir DH, $file or next;
- my @newfiles = readdir DH;
- closedir DH;
-
- @newfiles = File::Spec->no_upwards( @newfiles );
- @newfiles = grep { $_ ne "CVS" && $_ ne ".svn" } @newfiles;
-
- push @queue, map "$file/$_", @newfiles;
- }
- if ( -f $file ) {
- next unless $file =~ /\.pm$/;
-
- my @parts = File::Spec->splitdir( $file );
- shift @parts if @parts && exists $starters{$parts[0]};
- shift @parts if @parts && $parts[0] eq "lib";
- $parts[-1] =~ s/\.pm$// if @parts;
-
- # Untaint the parts
- for ( @parts ) {
- if ( /^([a-zA-Z0-9_\.\-]+)$/ && ($_ eq $1) ) {
- $_ = $1; # Untaint the original
- }
- else {
- die qq{Invalid and untaintable filename "$file"!};
- }
- }
- my $module = join( "::", @parts );
- push( @modules, $module );
- }
- } # while
-
- return @modules;
-}
-
-sub _starting_points {
- return 'blib' if -e 'blib';
- return 'lib';
-}
-
-=head1 BUGS
-
-Please report any bugs or feature requests to
-C<bug-test-pod-coverage at rt.cpan.org>, or through the web interface at
-L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Test-Pod-Coverage>.
-I will be notified, and then you'll automatically be notified of progress on
-your bug as I make changes.
-
-=head1 SUPPORT
-
-You can find documentation for this module with the perldoc command.
-
- perldoc Test::Pod::Coverage
-
-You can also look for information at:
-
-=over 4
-
-=item * AnnoCPAN: Annotated CPAN documentation
-
-L<http://annocpan.org/dist/Test-Pod-Coverage>
-
-=item * CPAN Ratings
-
-L<http://cpanratings.perl.org/d/Test-Pod-Coverage>
-
-=item * RT: CPAN's request tracker
-
-L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Test-Pod-Coverage>
-
-=item * Search CPAN
-
-L<http://search.cpan.org/dist/Test-Pod-Coverage>
-
-=back
-
-=head1 AUTHOR
-
-Written by Andy Lester, C<< <andy at petdance.com> >>.
-
-=head1 ACKNOWLEDGEMENTS
-
-Thanks to Ricardo Signes for patches, and Richard Clamp for
-writing Pod::Coverage.
-
-=head1 COPYRIGHT & LICENSE
-
-Copyright 2006, Andy Lester, All Rights Reserved.
-
-You may use, modify, and distribute this package under the
-same terms as Perl itself.
-
-=cut
-
-1;
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Test/Reporter.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Test/Reporter.pm
deleted file mode 100644
index efb638a97c1..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Test/Reporter.pm
+++ /dev/null
@@ -1,1085 +0,0 @@
-# Test::Reporter - sends test results to cpan-testers@perl.org
-#
-# Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008 Adam J. Foxson.
-# Copyright (C) 2008 David A. Golden
-# Copyright (C) 2008 Ricardo Signes
-# Copyright (C) 2004, 2005 Richard Soderberg.
-# All rights reserved.
-#
-# 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 the
-# GNU General Public License for more details.
-#
-# You should have received a copy of the GNU General Public License
-# along with this program. If not, see <http://www.gnu.org/licenses/>.
-
-package Test::Reporter;
-
-use strict;
-use Cwd;
-use Config;
-use Carp;
-use Net::SMTP;
-use FileHandle;
-use File::Temp;
-use Sys::Hostname;
-use Time::Local ();
-use vars qw($VERSION $AUTOLOAD $Tempfile $Report $DNS $Domain $Send);
-use constant FAKE_NO_NET_DNS => 0; # for debugging only
-use constant FAKE_NO_NET_DOMAIN => 0; # for debugging only
-use constant FAKE_NO_MAIL_SEND => 0; # for debugging only
-
-$VERSION = '1.4002';
-
-local $^W = 1;
-
-sub new {
- my $type = shift;
- my $class = ref($type) || $type;
- my $self = {
- '_mx' => ['mx.develooper.com'],
- '_address' => 'cpan-testers@perl.org',
- '_grade' => undef,
- '_distribution' => undef,
- '_report' => undef,
- '_subject' => undef,
- '_from' => undef,
- '_comments' => '',
- '_errstr' => '',
- '_via' => '',
- '_timeout' => 120,
- '_debug' => 0,
- '_dir' => '',
- '_subject_lock' => 0,
- '_report_lock' => 0,
- '_perl_version' => {
- '_archname' => $Config{archname},
- '_osvers' => $Config{osvers},
- '_myconfig' => Config::myconfig(),
- },
- '_transport' => '',
- '_transport_args' => [],
- '_mail_send_args' => '', # deprecated -> use _transport_args
- };
-
- bless $self, $class;
-
- $self->{_attr} = {
- map {$_ => 1} qw(
- _address _distribution _comments _errstr _via _timeout _debug _dir
- )
- };
-
- warn __PACKAGE__, ": new\n" if $self->debug();
- croak __PACKAGE__, ": new: even number of named arguments required"
- unless scalar @_ % 2 == 0;
-
- $self->_process_params(@_) if @_;
- $self->transport('Net::SMTP') unless $self->transport();
- $self->_get_mx(@_) if $self->_have_net_dns();
-
- return $self;
-}
-
-sub _get_mx {
- my $self = shift;
- warn __PACKAGE__, ": _get_mx\n" if $self->debug();
-
- my %params = @_;
-
- return if exists $params{'mx'};
-
- my $dom = $params{'address'} || $self->address();
- my @mx;
-
- $dom =~ s/^.+\@//;
-
- for my $mx (sort {$a->preference() <=> $b->preference()} Net::DNS::mx($dom)) {
- push @mx, $mx->exchange();
- }
-
- if (not @mx) {
- warn __PACKAGE__,
- ": _get_mx: unable to find MX's for $dom, using defaults\n" if
- $self->debug();
- return;
- }
-
- $self->mx(\@mx);
-}
-
-sub _process_params {
- my $self = shift;
- warn __PACKAGE__, ": _process_params\n" if $self->debug();
-
- my %params = @_;
- my @defaults = qw(
- mx address grade distribution from comments via timeout debug dir perl_version transport_args transport );
- my %defaults = map {$_ => 1} @defaults;
-
- for my $param (keys %params) {
- croak __PACKAGE__, ": new: parameter '$param' is invalid." unless
- exists $defaults{$param};
- }
-
- # XXX need to process transport_args directly rather than through
- # the following -- store array ref directly
- for my $param (keys %params) {
- $self->$param($params{$param});
- }
-}
-
-sub subject {
- my $self = shift;
- warn __PACKAGE__, ": subject\n" if $self->debug();
- croak __PACKAGE__, ": subject: grade and distribution must first be set"
- if not defined $self->{_grade} or not defined $self->{_distribution};
-
- return $self->{_subject} if $self->{_subject_lock};
-
- my $subject = uc($self->{_grade}) . ' ' . $self->{_distribution} .
- " $self->{_perl_version}->{_archname} $self->{_perl_version}->{_osvers}";
-
- return $self->{_subject} = $subject;
-}
-
-sub report {
- my $self = shift;
- warn __PACKAGE__, ": report\n" if $self->debug();
-
- return $self->{_report} if $self->{_report_lock};
-
- my $report;
- $report .= "This distribution has been tested as part of the cpan-testers\n";
- $report .= "effort to test as many new uploads to CPAN as possible. See\n";
- $report .= "http://testers.cpan.org/\n\n";
-
- if (not $self->{_comments}) {
- $report .= "\n\n--\n\n";
- }
- else {
- $report .= "\n--\n" . $self->{_comments} . "\n--\n\n";
- }
-
- $report .= $self->{_perl_version}->{_myconfig};
-
- chomp $report;
- chomp $report;
-
- return $self->{_report} = $report;
-}
-
-sub grade {
- my ($self, $grade) = @_;
- warn __PACKAGE__, ": grade\n" if $self->debug();
-
- my %grades = (
- 'pass' => "all tests passed",
- 'fail' => "one or more tests failed",
- 'na' => "distribution will not work on this platform",
- 'unknown' => "distribution did not include tests",
- );
-
- return $self->{_grade} if scalar @_ == 1;
-
- croak __PACKAGE__, ":grade: '$grade' is invalid, choose from: " .
- join ' ', keys %grades unless $grades{$grade};
-
- return $self->{_grade} = $grade;
-}
-
-sub transport {
- my $self = shift;
- warn __PACKAGE__, ": transport\n" if $self->debug();
-
- return $self->{_transport} unless scalar @_;
-
- my $transport = shift;
-
- my $transport_class = "Test::Reporter::Transport::$transport";
- unless ( eval "require $transport_class; 1" ) {
- croak __PACKAGE__ . ": could not load '$transport_class'\n$@\n";
- }
-
- my @args = @_;
-
- if ( @args && $transport eq 'Mail::Send' && ref $args[0] eq 'ARRAY' ) {
- # treat as old form of Mail::Send arguments and convert to list
- $self->transport_args(@{$args[0]});
- }
- elsif ( @args ) {
- $self->transport_args(@args);
- }
-
- return $self->{_transport} = $transport;
-}
-
-sub edit_comments {
- my($self, %args) = @_;
- warn __PACKAGE__, ": edit_comments\n" if $self->debug();
-
- my %tempfile_args = (
- UNLINK => 1,
- SUFFIX => '.txt',
- );
-
- if (exists $args{'suffix'} && defined $args{'suffix'} && length $args{'suffix'}) {
- $tempfile_args{SUFFIX} = $args{'suffix'};
- # prefix the extension with a period, if the user didn't.
- $tempfile_args{SUFFIX} =~ s/^(?!\.)(?=.)/./;
- }
-
- ($Tempfile, $Report) = File::Temp::tempfile(%tempfile_args);
-
- print $Tempfile $self->{_comments};
-
- $self->_start_editor();
-
- my $comments;
- {
- local $/;
- open FH, $Report or die __PACKAGE__, ": Can't open comment file '$Report': $!";
- $comments = <FH>;
- close FH or die __PACKAGE__, ": Can't close comment file '$Report': $!";
- }
-
- chomp $comments;
-
- $self->{_comments} = $comments;
-
- return;
-}
-
-sub send {
- my ($self, @recipients) = @_;
- warn __PACKAGE__, ": send\n" if $self->debug();
-
- $self->from();
- $self->report();
- $self->subject();
-
- return unless $self->_verify();
-
- if ($self->_is_a_perl_release($self->distribution())) {
- $self->errstr(__PACKAGE__ . ": use perlbug for reporting test " .
- "results against perl itself");
- return;
- }
-
- my $transport_type = $self->transport() || 'Net::SMTP';
- my $transport_class = "Test::Reporter::Transport::$transport_type";
- my $transport = $transport_class->new( $self->transport_args() );
-
- unless ( eval { $transport->send( $self, \@recipients ) } ) {
- $self->errstr(__PACKAGE__ . ": error from '$transport_class:'\n$@\n");
- return;
- }
-
- return 1;
-}
-
-sub write {
- my $self = shift;
- warn __PACKAGE__, ": write\n" if $self->debug();
-
- my $from = $self->from();
- my $report = $self->report();
- my $subject = $self->subject();
- my $distribution = $self->distribution();
- my $grade = $self->grade();
- my $dir = $self->dir() || cwd;
-
- return unless $self->_verify();
-
- $distribution =~ s/[^A-Za-z0-9\.\-]+//g;
-
- my($fh, $file); unless ($fh = $_[0]) {
- $file = "$grade.$distribution.$self->{_perl_version}->{_archname}.$self->{_perl_version}->{_osvers}.${\(time)}.$$.rpt";
-
- if ($^O eq 'VMS') {
- $file = "$grade.$distribution.$self->{_perl_version}->{_archname}";
- my $ext = "$self->{_perl_version}->{_osvers}.${\(time)}.$$.rpt";
- # only 1 period in filename
- # we also only have 39.39 for filename
- $file =~ s/\./_/g;
- $ext =~ s/\./_/g;
- $file = $file . '.' . $ext;
- }
-
- $file = File::Spec->catfile($dir, $file);
-
- warn $file if $self->debug();
- $fh = FileHandle->new();
- open $fh, ">$file" or die __PACKAGE__, ": Can't open report file '$file': $!";
- }
- print $fh "From: $from\n";
- print $fh "Subject: $subject\n";
- print $fh "Report: $report";
- unless ($_[0]) {
- close $fh or die __PACKAGE__, ": Can't close report file '$file': $!";
- warn $file if $self->debug();
- return $file;
- } else {
- return $fh;
- }
-}
-
-sub read {
- my ($self, $file) = @_;
- warn __PACKAGE__, ": read\n" if $self->debug();
-
- my $buffer;
-
- {
- local $/;
- open REPORT, $file or die __PACKAGE__, ": Can't open report file '$file': $!";
- $buffer = <REPORT>;
- close REPORT or die __PACKAGE__, ": Can't close report file '$file': $!";
- }
-
- if (my ($from, $subject, $report) = $buffer =~ /^From:\s(.+)Subject:\s(.+)Report:\s(.+)$/s) {
- my ($grade, $distribution) = (split /\s/, $subject)[0,1];
- $self->from($from) unless $self->from();
- $self->{_subject} = $subject;
- $self->{_report} = $report;
- $self->{_grade} = lc $grade;
- $self->{_distribution} = $distribution;
- $self->{_subject_lock} = 1;
- $self->{_report_lock} = 1;
- } else {
- die __PACKAGE__, ": Failed to parse report file '$file'\n";
- }
-
- return $self;
-}
-
-sub _verify {
- my $self = shift;
- warn __PACKAGE__, ": _verify\n" if $self->debug();
-
- my @undefined;
-
- for my $key (keys %{$self}) {
- push @undefined, $key unless defined $self->{$key};
- }
-
- $self->errstr(__PACKAGE__ . ": Missing values for: " .
- join ', ', map {$_ =~ /^_(.+)$/} @undefined) if
- scalar @undefined > 0;
- return $self->errstr() ? return 0 : return 1;
-}
-
-# Courtesy of Email::MessageID
-sub message_id {
- my $self = shift;
- warn __PACKAGE__, ": message_id\n" if $self->debug();
-
- my $unique_value = 0;
- my @CHARS = ('A'..'F','a'..'f',0..9);
- my $length = 3;
-
- $length = rand(8) until $length > 3;
-
- my $pseudo_random = join '', (map $CHARS[rand $#CHARS], 0 .. $length), $unique_value++;
- my $user = join '.', time, $pseudo_random, $$;
-
- return '<' . $user . '@' . Sys::Hostname::hostname() . '>';
-}
-
-sub from {
- my $self = shift;
- warn __PACKAGE__, ": from\n" if $self->debug();
-
- if (@_) {
- $self->{_from} = shift;
- return $self->{_from};
- }
- else {
- return $self->{_from} if defined $self->{_from} and $self->{_from};
- $self->{_from} = $self->_mailaddress();
- return $self->{_from};
- }
-
-}
-
-sub mx {
- my $self = shift;
- warn __PACKAGE__, ": mx\n" if $self->debug();
-
- if (@_) {
- my $mx = shift;
- croak __PACKAGE__,
- ": mx: array reference required" if ref $mx ne 'ARRAY';
- $self->{_mx} = $mx;
- }
-
- return $self->{_mx};
-}
-
-# Deprecated, but kept for backwards compatibility
-# Passes through to transport_args -- converting from array ref to list to
-# store and converting from list to array ref to get
-sub mail_send_args {
- my $self = shift;
- warn __PACKAGE__, ": mail_send_args\n" if $self->debug();
- croak __PACKAGE__, ": mail_send_args cannot be called unless Mail::Send is installed\n" unless $self->_have_mail_send();
- if (@_) {
- my $mail_send_args = shift;
- croak __PACKAGE__, ": mail_send_args: array reference required\n"
- if ref $mail_send_args ne 'ARRAY';
- $self->transport_args(@$mail_send_args);
- }
- return [ $self->transport_args() ];
-}
-
-
-
-sub transport_args {
- my $self = shift;
- warn __PACKAGE__, ": transport_args\n" if $self->debug();
-
- if (@_) {
- $self->{_transport_args} = ref $_[0] eq 'ARRAY' ? $_[0] : [ @_ ];
- }
-
- return @{ $self->{_transport_args} };
-}
-
-
-sub perl_version {
- my $self = shift;
- warn __PACKAGE__, ": perl_version\n" if $self->debug();
-
- if( @_) {
- my $perl = shift;
- my $q = ( ($^O eq "MSWin32") || ($^O eq 'VMS') ) ? '"' : "'"; # quote for command-line perl
- my $magick = int(rand(1000)); # just to check that we get a valid result back
- my $cmd = "$perl -MConfig -e$q print qq{$magick\n\$Config{archname}\n\$Config{osvers}\n},Config::myconfig();$q";
- if($^O eq 'VMS'){
- my $sh = $Config{'sh'};
- $cmd = "$sh $perl $q-MConfig$q -e$q print qq{$magick\\n\$Config{archname}\\n\$Config{osvers}\\n},Config::myconfig();$q";
- }
- my $conf = `$cmd`;
- my %conf;
- ( @conf{ qw( magick _archname _osvers _myconfig) } ) = split( /\n/, $conf, 4);
- croak __PACKAGE__, ": cannot get perl version info from $perl: $conf" if( $conf{magick} ne $magick);
- delete $conf{magick};
- $self->{_perl_version} = \%conf;
- }
- return $self->{_perl_version};
-}
-
-sub AUTOLOAD {
- my $self = $_[0];
- my ($package, $method) = ($AUTOLOAD =~ /(.*)::(.*)/);
-
- return if $method =~ /^DESTROY$/;
-
- unless ($self->{_attr}->{"_$method"}) {
- croak __PACKAGE__, ": No such method: $method; aborting";
- }
-
- my $code = q{
- sub {
- my $self = shift;
- warn __PACKAGE__, ": METHOD\n" if $self->{_debug};
- $self->{_METHOD} = shift if @_;
- return $self->{_METHOD};
- }
- };
-
- $code =~ s/METHOD/$method/g;
-
- {
- no strict 'refs';
- *$AUTOLOAD = eval $code;
- }
-
- goto &$AUTOLOAD;
-}
-
-sub _have_net_dns {
- my $self = shift;
- warn __PACKAGE__, ": _have_net_dns\n" if $self->debug();
-
- return $DNS if defined $DNS;
- return 0 if FAKE_NO_NET_DNS;
-
- $DNS = eval {require Net::DNS};
-}
-
-sub _have_net_domain {
- my $self = shift;
- warn __PACKAGE__, ": _have_net_domain\n" if $self->debug();
-
- return $Domain if defined $Domain;
- return 0 if FAKE_NO_NET_DOMAIN;
-
- $Domain = eval {require Net::Domain};
-}
-
-sub _have_mail_send {
- my $self = shift;
- warn __PACKAGE__, ": _have_mail_send\n" if $self->debug();
-
- return $Send if defined $Send;
- return 0 if FAKE_NO_MAIL_SEND;
-
- $Send = eval {require Mail::Send};
-}
-
-sub _start_editor {
- my $self = shift;
- warn __PACKAGE__, ": _start_editor\n" if $self->debug();
-
- my $editor = $ENV{VISUAL} || $ENV{EDITOR} || $ENV{EDIT}
- || ($^O eq 'VMS' and "edit/tpu")
- || ($^O eq 'MSWin32' and "notepad")
- || 'vi';
-
- $editor = $self->_prompt('Editor', $editor);
-
- die __PACKAGE__, ": The editor `$editor' could not be run" if system "$editor $Report";
- die __PACKAGE__, ": Report has disappeared; terminated" unless -e $Report;
- die __PACKAGE__, ": Empty report; terminated" unless -s $Report > 2;
-}
-
-sub _prompt {
- my $self = shift;
- warn __PACKAGE__, ": _prompt\n" if $self->debug();
-
- my ($label, $default) = @_;
-
- printf "$label%s", (" [$default]: ");
- my $input = scalar <STDIN>;
- chomp $input;
-
- return (length $input) ? $input : $default;
-}
-
-# From Mail::Util 1.74 (c) 1995-2001 Graham Barr (c) 2002-2005 Mark Overmeer
-sub _maildomain {
- my $self = shift;
- warn __PACKAGE__, ": _maildomain\n" if $self->debug();
-
- my $domain = $ENV{MAILDOMAIN};
-
- return $domain if defined $domain;
-
- local *CF;
- local $_;
-
- my @sendmailcf = qw(
- /etc /etc/sendmail /etc/ucblib /etc/mail /usr/lib /var/adm/sendmail
- );
-
- my $config = (grep(-r, map("$_/sendmail.cf", @sendmailcf)))[0];
-
- if (defined $config && open(CF, $config)) {
- my %var;
- while (<CF>) {
- if (my ($v, $arg) = /^D([a-zA-Z])([\w.\$\-]+)/) {
- $arg =~ s/\$([a-zA-Z])/exists $var{$1} ? $var{$1} : '$'.$1/eg;
- $var{$v} = $arg;
- }
- }
- close(CF) || die $!;
- $domain = $var{j} if defined $var{j};
- $domain = $var{M} if defined $var{M};
-
- $domain = $1
- if ($domain && $domain =~ m/([A-Za-z0-9](?:[\.\-A-Za-z0-9]+))/);
-
- undef $domain if $^O eq 'darwin' && $domain =~ /\.local$/;
-
- return $domain if (defined $domain && $domain !~ /\$/);
- }
-
- if (open(CF, "/usr/lib/smail/config")) {
- while (<CF>) {
- if (/\A\s*hostnames?\s*=\s*(\S+)/) {
- $domain = (split(/:/,$1))[0];
- undef $domain if $^O eq 'darwin' && $domain =~ /\.local$/;
- last if defined $domain and $domain;
- }
- }
- close(CF) || die $!;
-
- return $domain if defined $domain;
- }
-
- if (eval {require Net::SMTP}) {
- my $host;
-
- for $host (qw(mailhost localhost)) {
- my $smtp = eval {Net::SMTP->new($host)};
-
- if (defined $smtp) {
- $domain = $smtp->domain;
- $smtp->quit;
- undef $domain if $^O eq 'darwin' && $domain =~ /\.local$/;
- last if defined $domain and $domain;
- }
- }
- }
-
- unless (defined $domain) {
- if ($self->_have_net_domain()) {
- ###################################################################
- # The below statement might possibly exhibit intermittent blocking
- # behavior. Be advised!
- ###################################################################
- $domain = Net::Domain::domainname();
- undef $domain if $^O eq 'darwin' && $domain =~ /\.local$/;
- }
- }
-
- $domain = "localhost" unless defined $domain;
-
- return $domain;
-}
-
-# From Mail::Util 1.74 (c) 1995-2001 Graham Barr (c) 2002-2005 Mark Overmeer
-sub _mailaddress {
- my $self = shift;
- warn __PACKAGE__, ": _mailaddress\n" if $self->debug();
-
- my $mailaddress = $ENV{MAILADDRESS};
- $mailaddress ||= $ENV{USER} ||
- $ENV{LOGNAME} ||
- eval {getpwuid($>)} ||
- "postmaster";
- $mailaddress .= '@' . $self->_maildomain() unless $mailaddress =~ /\@/;
- $mailaddress =~ s/(^.*<|>.*$)//g;
-
- my $realname = $self->_realname();
- if ($realname) {
- $mailaddress = "$mailaddress ($realname)";
- }
-
- return $mailaddress;
-}
-
-sub _realname {
- my $self = shift;
- warn __PACKAGE__, ": _realname\n" if $self->debug();
-
- my $realname = '';
-
- $realname =
- eval {(split /,/, (getpwuid($>))[6])[0]} ||
- $ENV{QMAILNAME} ||
- $ENV{REALNAME} ||
- $ENV{USER};
-
- return $realname;
-}
-
-sub _is_a_perl_release {
- my $self = shift;
- warn __PACKAGE__, ": _is_a_perl_release\n" if $self->debug();
-
- my $perl = shift;
-
- return $perl =~ /^perl-?\d\.\d/;
-}
-
-__END__
-
-=head1 NAME
-
-Test::Reporter - sends test results to cpan-testers@perl.org
-
-=head1 SYNOPSIS
-
- use Test::Reporter;
-
- my $reporter = Test::Reporter->new();
-
- $reporter->grade('pass');
- $reporter->distribution('Mail-Freshmeat-1.20');
- $reporter->send() || die $reporter->errstr();
-
- # or
-
- my $reporter = Test::Reporter->new();
-
- $reporter->grade('fail');
- $reporter->distribution('Mail-Freshmeat-1.20');
- $reporter->comments('output of a failed make test goes here...');
- $reporter->edit_comments(); # if you want to edit comments in an editor
- $reporter->send('afoxson@cpan.org') || die $reporter->errstr();
-
- # or
-
- my $reporter = Test::Reporter->new(
- grade => 'fail',
- distribution => 'Mail-Freshmeat-1.20',
- from => 'whoever@wherever.net (Whoever Wherever)',
- comments => 'output of a failed make test goes here...',
- via => 'CPANPLUS X.Y.Z',
- );
- $reporter->send() || die $reporter->errstr();
-
-=head1 DESCRIPTION
-
-Test::Reporter reports the test results of any given distribution to the CPAN
-Testers. Test::Reporter has wide support for various perl5's and platforms. For
-further information visit the below links:
-
-=over 4
-
-=item * L<http://cpantesters.perl.org/>
-
-CPAN Testers reports (new site)
-
-=item * L<http://testers.cpan.org/>
-
-CPAN Testers reports (old site)
-
-=item * L<http://cpantest.grango.org/>
-
-The new CPAN Testers Wiki (thanks Barbie!)
-
-=item * L<http://lists.cpan.org/showlist.cgi?name=cpan-testers>
-
-The cpan-testers mailing list
-
-=back
-
-Test::Reporter itself--as a project--also has several links for your visiting
-enjoyment:
-
-=over 4
-
-=item * L<http://code.google.com/p/test-reporter/>
-
-Test::Reporter's master project page
-
-=item * L<http://groups.google.com/group/test-reporter>
-
-Discussion group for Test::Reporter
-
-=item * L<http://code.google.com/p/test-reporter/w/list>
-
-The Wiki for Test::Reporter
-
-=item * L<http://eclipse.resort.org/git/gitweb.cgi?p=test-reporter.git>
-
-Test::Reporter's public git source code repository.
-
-=item * L<http://search.cpan.org/dist/Test-Reporter/>
-
-Test::Reporter on CPAN
-
-=item * L<http://code.google.com/p/test-reporter/issues/list>
-
-UNFORTUNATELY, WE ARE UNABLE TO ACCEPT TICKETS FILED WITH RT.
-
-Please file all bug reports and enhancement requests at our Google Code issue
-tracker. Thank you for your support and understanding.
-
-=item * L<http://backpan.cpan.org/authors/id/F/FO/FOX/>
-
-=item * L<http://backpan.cpan.org/authors/id/A/AF/AFOXSON/>
-
-If you happen to--for some strange reason--be looking for primordial versions
-of Test::Reporter, you can almost certainly find them at the above 2 links.
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item * B<address>
-
-Optional. Gets or sets the e-mail address that the reports will be
-sent to. By default, this is set to cpan-testers@perl.org. You shouldn't
-need this unless the CPAN Tester's change the e-mail address to send
-report's to.
-
-=item * B<comments>
-
-Optional. Gets or sets the comments on the test report. This is most
-commonly used for distributions that did not pass a 'make test'.
-
-=item * B<debug>
-
-Optional. Gets or sets the value that will turn debugging on or off.
-Debug messages are sent to STDERR. 1 for on, 0 for off. Debugging
-generates very verbose output and is useful mainly for finding bugs
-in Test::Reporter itself.
-
-=item * B<dir>
-
-Optional. Defaults to the current working directory. This method specifies
-the directory that write() writes test report files to.
-
-=item * B<distribution>
-
-Gets or sets the name of the distribution you're working on, for example
-Foo-Bar-0.01. There are no restrictions on what can be put here.
-
-=item * B<edit_comments>
-
-Optional. Allows one to interactively edit the comments within a text
-editor. comments() doesn't have to be first specified, but it will work
-properly if it was. Accepts an optional hash of arguments:
-
-=over 4
-
-=item * B<suffix>
-
-Optional. Allows one to specify the suffix ("extension") of the temp
-file used by B<edit_comments>. Defaults to '.txt'.
-
-=back
-
-=item * B<errstr>
-
-Returns an error message describing why something failed. You must check
-errstr() on a send() in order to be guaranteed delivery. This is optional
-if you don't intend to use Test::Reporter to send reports via e-mail,
-see 'send' below for more information.
-
-=item * B<from>
-
-Optional. Gets or sets the e-mail address of the individual submitting
-the test report, i.e. "afoxson@pobox.com (Adam Foxson)". This is
-mostly of use to testers running under Windows, since Test::Reporter
-will usually figure this out automatically. Alternatively, you can use
-the MAILADDRESS environmental variable to accomplish the same.
-
-=item * B<grade>
-
-Gets or sets the success or failure of the distributions's 'make test'
-result. This must be one of:
-
- grade meaning
- ----- -------
- pass all tests passed
- fail one or more tests failed
- na distribution will not work on this platform
- unknown distribution did not include tests
-
-=item * B<mail_send_args> -- DEPRECATED
-
-Kept for backwards compatibility. Use C<transport_args> instead.
-
-Optional. If you have MailTools installed and you want to have it
-behave in a non-default manner, parameters that you give this
-method will be passed directly to the constructor of
-Mail::Mailer. See L<Mail::Mailer> and L<Mail::Send> for details.
-
-=item * B<message_id>
-
-Returns an automatically generated Message ID. This Message ID will later
-be included as an outgoing mail header in the test report e-mail. This was
-included to conform to local mail policies at perl.org. This method courtesy
-of Email::MessageID.
-
-=item * B<mx>
-
-Optional. Gets or sets the mail exchangers that will be used to send
-the test reports. If you override the default values make sure you
-pass in a reference to an array. By default, this contains the MX's
-known at the time of release for perl.org. If you do not have
-Mail::Send installed (thus using the Net::SMTP interface) and do have
-Net::DNS installed it will dynamically retrieve the latest MX's. You
-really shouldn't need to use this unless the hardcoded MX's have
-become wrong and you don't have Net::DNS installed.
-
-=item * B<new>
-
-This constructor returns a Test::Reporter object. It will optionally accept
-named parameters for: mx, address, grade, distribution, from, comments,
-via, timeout, debug, dir, perl_version, and transport.
-
-=item * B<perl_version>
-
-Returns a hashref containing _archname, _osvers, and _myconfig based upon the
-perl that you are using. Alternatively, you may supply a different perl (path
-to the binary) as an argument, in which case the supplied perl will be used as
-the basis of the above data.
-
-=item * B<report>
-
-Returns the actual content of a report, i.e.
-"This distribution has been tested as part of the cpan-testers...".
-'comments' must first be specified before calling this method, if you have
-comments to make and expect them to be included in the report.
-
-=item * B<send>
-
-Sends the test report to cpan-testers@perl.org and cc's the e-mail to the
-specified recipients, if any. If you do specify recipients to be cc'd and
-you do not have Mail::Send installed be sure that you use the author's
-@cpan.org address otherwise they will not be delivered. You must check
-errstr() on a send() in order to be guaranteed delivery. Technically, this
-is optional, as you may use Test::Reporter to only obtain the 'subject' and
-'report' without sending an e-mail at all, although that would be unusual.
-
-=item * B<subject>
-
-Returns the subject line of a report, i.e.
-"PASS Mail-Freshmeat-1.20 Darwin 6.0". 'grade' and 'distribution' must
-first be specified before calling this method.
-
-=item * B<timeout>
-
-Optional. Gets or sets the timeout value for the submission of test
-reports. Default is 120 seconds.
-
-=item * B<transport>
-
-Optional. Gets or sets the transport type. The transport type argument is
-refers to a 'Test::Reporter::Transport' subclass. The default is 'Net::SMTP',
-which uses the [Test::Reporter::Transport::Net::SMTP] class.
-
-You can add additional arguments after the transport
-selection. These will be passed to the constructor of the lower-level
-transport. This can be used to great effect for all manner of fun and
-enjoyment. ;-) See C<transport_args>.
-
-If L<Net::SMTP::TLS> is used, 'Username' and 'Password' key-value transport
-arguments must be provided.
-
- $reporter->transport(
- 'Net::SMTP::TLS', Username => 'jdoe', Password => '123'
- );
-
-If the 'HTTP' transport is used, two additional arguments are required:
-a URL to a L<Test::Reporter::HTTPGateway> compatible server and an (optional)
-API key.
-
- $reporter->transport(
- 'HTTP', 'http://example.com/reporter-gateway/', '123456'
- );
-
-This is not designed to be an extensible platform upon which to build
-transport plugins. That functionality is planned for the next-generation
-release of Test::Reporter, which will reside in the CPAN::Testers namespace.
-
-=item * B<transport_args>
-
-Optional. Gets or sets transport arguments that will used in the constructor
-for the selected transport, as appropriate.
-
-=item * B<via>
-
-Optional. Gets or sets the value that will be appended to
-X-Reported-Via, generally this is useful for distributions that use
-Test::Reporter to report test results. This would be something
-like "CPANPLUS 0.036".
-
-=item * B<write and read>
-
-These methods are used in situations where you test on a machine that has
-port 25 blocked and there is no local MTA. You use write() on the machine
-that you are testing from, transfer the written test reports from the
-testing machine to the sending machine, and use read() on the machine that
-you actually want to submit the reports from. write() will write a file in
-an internal format that contains 'From', 'Subject', and the content of the
-report. The filename will be represented as:
-grade.distribution.archname.osvers.seconds_since_epoch.pid.rpt. write()
-uses the value of dir() if it was specified, else the cwd.
-
-On the machine you are testing from:
-
- my $reporter = Test::Reporter->new
- (
- grade => 'pass',
- distribution => 'Test-Reporter-1.16',
- )->write();
-
-On the machine you are submitting from:
-
- my $reporter;
- $reporter = Test::Reporter->new()->read('pass.Test-Reporter-1.16.i686-linux.2.2.16.1046685296.14961.rpt')->send() || die $reporter->errstr(); # wrap in an opendir if you've a lot to submit
-
-write() also accepts an optional filehandle argument:
-
- my $fh; open $fh, '>-'; # create a STDOUT filehandle object
- $reporter->write($fh); # prints the report to STDOUT
-
-=back
-
-=head1 CAVEATS
-
-If you specify recipients to be cc'd while using send() (and you do not have
-Mail::Send installed) be sure that you use the author's @cpan.org address
-otherwise they may not be delivered, since the perl.org MX's are unlikely
-to relay for anything other than perl.org and cpan.org.
-
-If you experience a long delay sending mail with Test::Reporter, you may be
-experiencing a wait as Test::Reporter attempts to determine your email
-domain. Setting the MAILDOMAIN environment variable will avoid this delay.
-
-=head1 COPYRIGHT
-
- Copyright (C) 2008 David A. Golden.
- Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008 Adam J. Foxson.
- Copyright (C) 2004, 2005 Richard Soderberg.
- All rights reserved.
-
-=head1 LICENSE
-
-This program is free software; you may redistribute it
-and/or modify it under the same terms as Perl itself.
-
-=head1 SEE ALSO
-
-=over 4
-
-=item * L<perl>
-
-=item * L<Config>
-
-=item * L<Net::SMTP>
-
-=item * L<Net::SMTP::TLS>
-
-=item * L<File::Spec>
-
-=item * L<File::Temp>
-
-=item * L<Net::Domain>
-
-This is optional. If it's installed Test::Reporter will try even
-harder at guessing your mail domain.
-
-=item * L<Net::DNS>
-
-This is optional. If it's installed Test::Reporter will dynamically
-retrieve the mail exchangers for perl.org, instead of relying on the
-MX's known at the time of this release.
-
-=item * L<Mail::Send>
-
-This is optional. If it's installed Test::Reporter will use Mail::Send
-instead of Net::SMTP.
-
-=item * L<Test::Reporter::HTTPGateway>
-
-This is optional. It provides a web API for the 'HTTP' transport method.
-
-=back
-
-=head1 AUTHOR
-
-Adam J. Foxson E<lt>F<afoxson@pobox.com>E<gt> and
-Richard Soderberg E<lt>F<rsod@cpan.org>E<gt>, with much deserved credit to
-Kirrily "Skud" Robert E<lt>F<skud@cpan.org>E<gt>, and
-Kurt Starsinic E<lt>F<Kurt.Starsinic@isinet.com>E<gt> for predecessor versions
-(CPAN::Test::Reporter, and cpantest respectively).
-
-Additional contributions by David A. Golden and Ricardo Signes.
-
-=cut
-
-1;
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Test/Reporter/Transport.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Test/Reporter/Transport.pm
deleted file mode 100644
index 6d41eb913f0..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Test/Reporter/Transport.pm
+++ /dev/null
@@ -1,118 +0,0 @@
-use strict;
-use warnings;
-package Test::Reporter::Transport;
-use vars qw/$VERSION/;
-$VERSION = '1.4002';
-$VERSION = eval $VERSION;
-
-sub new { die "Not implemented" }
-
-sub send { die "Not implemented" }
-
-1;
-
-__END__
-
-=head1 NAME
-
-Test::Reporter::Transport - base class for Test::Reporter transports
-
-=head1 SYNOPSIS
-
- # Defines API that must be implemented by subclasses
-
- my $sender = Test::Reporter::Transport::Subclass->new( @args );
-
- $sender->send( $report )
-
-=head1 DESCRIPTION
-
-Transport subclasses provide the means by which CPAN Testers reports are
-transmitted to the CPAN Testers mailing list.
-
-This module is an abstract base class that define an API for
-Test::Reporter::Transport subclasses. Individual subclasses MUST
-implement the methods described below.
-
-=head1 USAGE
-
-A transport method is specified to Test::Reporter using the C<transport>
-option. The C<transport> option expects just the module "suffix" that follows
-C<Test::Reporter::Transport>. For example:
-
- # use Test::Reporter::Transport::Net::SMTP for transport
- my $report = Test::Reporter->new(
- transport => 'Net::SMTP'
- );
-
- # use Test::Reporter::Transport::Mail::Send for transport
- my $report = Test::Reporter->new(
- transport => 'Mail::Send'
- );
-
-Configuration of the transport is specified with the C<transport_args>
-option:
-
- my $report = Test::Reporter->new(
- transport => 'Net::SMTP::TLS',
- transport_args => [ User => 'John', Password => '123' ],
- );
-
-These may also be specified with the C<transport> or C<transport_args> methods:
-
- $report->transport_args( User => 'John', Password => '123' );
-
-These may also be combined in the C<transport> method itself:
-
- $report->transport( 'Net::SMTP::TLS', User => 'John', Password => '123');
-
-=head1 METHODS
-
-The terms 'may', 'must', 'should', etc. used below have their usual RFC
-meanings.
-
-=head2 new
-
- my $sender = $subclass->new( @args );
-
-The C<new> method is the object constructor. It MAY take a list of any
-necessary configuration options. It MUST return a transport object if one
-is successfully created or undef if the object can not be created.
-
-=head2 send
-
- $sender->send( $report );
-
-The C<send> method MUST take a Test::Reporter object as its only argument. It
-MUST return true if the report is successfully sent. It SHOULD die with a
-message describing the failure if a report cannot be sent. It MUST NOT return
-a true value if the report cannot be sent.
-
-=head1 AUTHOR
-
-=over
-
-=item *
-
-David A. Golden (DAGOLDEN)
-
-=item *
-
-Ricardo Signes (RJBS)
-
-=back
-
-=head1 COPYRIGHT
-
- Copyright (C) 2008 David A. Golden
- Copyright (C) 2008 Ricardo Signes
-
- All rights reserved.
-
-=head1 LICENSE
-
-This program is free software; you may redistribute it
-and/or modify it under the same terms as Perl itself.
-
-=cut
-
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Test/Reporter/Transport/File.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Test/Reporter/Transport/File.pm
deleted file mode 100644
index e956e893a80..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Test/Reporter/Transport/File.pm
+++ /dev/null
@@ -1,103 +0,0 @@
-use strict;
-use warnings;
-package Test::Reporter::Transport::File;
-use base 'Test::Reporter::Transport';
-use vars qw/$VERSION/;
-$VERSION = '1.4002';
-$VERSION = eval $VERSION;
-
-sub new {
- my ($class, $dir) = @_;
-
- die "target directory '$dir' doesn't exist or can't be written to"
- unless -d $dir && -w $dir;
-
- return bless { dir => $dir } => $class;
-}
-
-sub send {
- my ($self, $report) = @_;
- $report->dir( $self->{dir} );
- return $report->write();
-}
-
-1;
-
-__END__
-
-=head1 NAME
-
-Test::Reporter::Transport::File - File transport for Test::Reporter
-
-=head1 SYNOPSIS
-
- my $report = Test::Reporter->new(
- transport => 'File',
- transport_args => [ $dir ],
- );
-
-=head1 DESCRIPTION
-
-This module saves a Test::Reporter report to the specified directory (using
-the C<write> method from Test::Reporter.
-
-This lets you save reports during offline operation. The files may later be
-uploaded using C<< Test::Reporter->read() >>.
-
- Test::Reporter->read( $file )->send();
-
-=head1 USAGE
-
-See L<Test::Reporter> and L<Test::Reporter::Transport> for general usage
-information.
-
-=head2 Transport Arguments
-
- $report->transport_args( $dir );
-
-This transport class must have a writeable directory as its argument.
-
-=head1 METHODS
-
-These methods are only for internal use by Test::Reporter.
-
-=head2 new
-
- my $sender = Test::Reporter::Transport::File->new( $dir );
-
-The C<new> method is the object constructor.
-
-=head2 send
-
- $sender->send( $report );
-
-The C<send> method transmits the report.
-
-=head1 AUTHOR
-
-=over
-
-=item *
-
-David A. Golden (DAGOLDEN)
-
-=item *
-
-Ricardo Signes (RJBS)
-
-=back
-
-=head1 COPYRIGHT
-
- Copyright (C) 2008 David A. Golden
- Copyright (C) 2008 Ricardo Signes
-
- All rights reserved.
-
-=head1 LICENSE
-
-This program is free software; you may redistribute it and/or modify it under
-the same terms as Perl itself.
-
-=cut
-
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Test/Reporter/Transport/HTTPGateway.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Test/Reporter/Transport/HTTPGateway.pm
deleted file mode 100644
index 8a54156ed09..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Test/Reporter/Transport/HTTPGateway.pm
+++ /dev/null
@@ -1,128 +0,0 @@
-use strict;
-use warnings;
-package Test::Reporter::Transport::HTTPGateway;
-use base 'Test::Reporter::Transport';
-use vars qw/$VERSION/;
-$VERSION = '1.4002';
-$VERSION = eval $VERSION;
-
-use LWP::UserAgent;
-
-sub new {
- my ($class, $url, $key) = @_;
-
- die "invalid gateway URL: must be absolute http or https URL"
- unless $url =~ /\Ahttps?:/i;
-
- bless { gateway => $url, key => $key } => $class;
-}
-
-sub send {
- my ($self, $report) = @_;
-
- # construct the "via"
- my $report_class = ref $report;
- my $report_version = $report->VERSION;
- my $via = "$report_class $report_version";
- $via .= ', via ' . $report->via if $report->via;
-
- # post the report
- my $ua = LWP::UserAgent->new;
- $ua->timeout(60);
- $ua->env_proxy;
-
- my $form = {
- key => $self->{key},
- via => $via,
- from => $report->from,
- subject => $report->subject,
- report => $report->report,
- };
-
- my $res = $ua->post($self->{gateway}, $form);
-
- return 1 if $res->is_success;
-
- die sprintf "HTTP error: %s: %s", $res->status_line, $res->content;
-}
-
-1;
-
-__END__
-
-=head1 NAME
-
-Test::Reporter::Transport::HTTPGateway - HTTP transport for Test::Reporter
-
-=head1 SYNOPSIS
-
- my $report = Test::Reporter->new(
- transport => 'HTTPGateway',
- transport_args => [ $url, $key ],
- );
-
-=head1 DESCRIPTION
-
-This module transmits a Test::Reporter report via HTTP to a
-L<Test::Reporter::HTTPGateway> server (or something with an equivalent API).
-
-=head1 USAGE
-
-See L<Test::Reporter> and L<Test::Reporter::Transport> for general usage
-information.
-
-=head2 Transport Arguments
-
- $report->transport_args( $url, $key );
-
-This transport class accepts two positional arguments. The first is required
-and specifies the URL for the HTTPGateway server. The second argument
-specifies an API key to transmit to the gatway. It is optional for the
-transport class, but may be required by particular gateway servers.
-
-=head1 METHODS
-
-These methods are only for internal use by Test::Reporter.
-
-=head2 new
-
- my $sender = Test::Reporter::Transport::HTTPGateway->new(
- @args
- );
-
-The C<new> method is the object constructor.
-
-=head2 send
-
- $sender->send( $report );
-
-The C<send> method transmits the report.
-
-=head1 AUTHOR
-
-=over
-
-=item *
-
-David A. Golden (DAGOLDEN)
-
-=item *
-
-Ricardo Signes (RJBS)
-
-=back
-
-=head1 COPYRIGHT
-
- Copyright (C) 2008 David A. Golden
- Copyright (C) 2008 Ricardo Signes
-
- All rights reserved.
-
-=head1 LICENSE
-
-This program is free software; you may redistribute it and/or modify it under
-the same terms as Perl itself.
-
-=cut
-
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Test/Reporter/Transport/Mail/Send.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Test/Reporter/Transport/Mail/Send.pm
deleted file mode 100644
index cf0dfd7a9f0..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Test/Reporter/Transport/Mail/Send.pm
+++ /dev/null
@@ -1,121 +0,0 @@
-use strict;
-use warnings;
-package Test::Reporter::Transport::Mail::Send;
-use base 'Test::Reporter::Transport';
-use vars qw/$VERSION/;
-$VERSION = '1.4002';
-$VERSION = eval $VERSION;
-
-use Mail::Send;
-
-sub new {
- my ($class, @args) = @_;
- bless { args => \@args } => $class;
-}
-
-sub send {
- my ($self, $report, $recipients) = @_;
- $recipients ||= [];
-
- my $via = $report->via();
- my $msg = Mail::Send->new();
-
- my $cc_str;
- if (@$recipients) {
- $cc_str = join ', ', @$recipients;
- chomp $recipients;
- chomp $recipients;
- }
-
- $via = ', via ' . $via if $via;
-
- $msg->to($report->address());
- $msg->set('From', $report->from());
- $msg->subject($report->subject());
- $msg->add('X-Reported-Via', "Test::Reporter $Test::Reporter::VERSION$via");
- $msg->add('Cc', $recipients) if @_;
-
- my $fh = $msg->open( @{ $self->{args} } );
-
- print $fh $self->report();
-
- $fh->close();
-}
-
-1;
-
-__END__
-
-=head1 NAME
-
-Test::Reporter::Transport::Mail::Send - Mail::Send transport for Test::Reporter
-
-=head1 SYNOPSIS
-
- my $report = Test::Reporter->new(
- transport => 'Mail::Send',
- transport_args => [ @mail_send_args ],
- );
-
-=head1 DESCRIPTION
-
-This module transmits a Test::Reporter report using Mail::Send.
-
-=head1 USAGE
-
-See L<Test::Reporter> and L<Test::Reporter::Transport> for general usage
-information.
-
-=head2 Transport Arguments
-
- $report->transport_args( @mail_send_args );
-
-Any arguments supplied are passed to the Mail::Send constructor.
-
-=head1 METHODS
-
-These methods are only for internal use by Test::Reporter.
-
-=head2 new
-
- my $sender = Test::Reporter::Transport::Mail::Send->new(
- @args
- );
-
-The C<new> method is the object constructor.
-
-=head2 send
-
- $sender->send( $report );
-
-The C<send> method transmits the report.
-
-=head1 AUTHOR
-
-=over
-
-=item *
-
-David A. Golden (DAGOLDEN)
-
-=item *
-
-Ricardo Signes (RJBS)
-
-=back
-
-=head1 COPYRIGHT
-
- Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008 Adam J. Foxson.
- Copyright (C) 2004, 2005 Richard Soderberg.
- Copyright (C) 2008 David A. Golden
- Copyright (C) 2008 Ricardo Signes
-
- All rights reserved.
-
-=head1 LICENSE
-
-This program is free software; you may redistribute it and/or modify it under
-the same terms as Perl itself.
-
-=cut
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Test/Reporter/Transport/Net/SMTP.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Test/Reporter/Transport/Net/SMTP.pm
deleted file mode 100644
index 17fa6208c5a..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Test/Reporter/Transport/Net/SMTP.pm
+++ /dev/null
@@ -1,216 +0,0 @@
-use strict;
-use warnings;
-package Test::Reporter::Transport::Net::SMTP;
-use base 'Test::Reporter::Transport';
-use vars qw/$VERSION/;
-$VERSION = '1.4002';
-$VERSION = eval $VERSION;
-
-sub new {
- my ($class, @args) = @_;
- bless { args => \@args } => $class;
-}
-
-sub _net_class {
- my ($self) = @_;
- my $class = ref $self ? ref $self : $self;
- my ($net_class) = ($class =~ /^Test::Reporter::Transport::(.+)\z/);
- return $net_class;
-}
-
-# Next two subs courtesy of Casey West, Ricardo SIGNES, and Email::Date
-# Visit the Perl Email Project at: http://emailproject.perl.org/
-sub _tz_diff {
- my ($self, $time) = @_;
-
- my $diff = Time::Local::timegm(localtime $time)
- - Time::Local::timegm(gmtime $time);
-
- my $direc = $diff < 0 ? '-' : '+';
- $diff = abs $diff;
- my $tz_hr = int( $diff / 3600 );
- my $tz_mi = int( $diff / 60 - $tz_hr * 60 );
-
- return ($direc, $tz_hr, $tz_mi);
-}
-
-sub _format_date {
- my ($self, $time) = @_;
- $time = time unless defined $time;
-
- my ($sec, $min, $hour, $mday, $mon, $year, $wday) = (localtime $time);
- my $day = (qw[Sun Mon Tue Wed Thu Fri Sat])[$wday];
- my $month = (qw[Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec])[$mon];
- $year += 1900;
-
- my ($direc, $tz_hr, $tz_mi) = $self->_tz_diff($time);
-
- sprintf "%s, %d %s %d %02d:%02d:%02d %s%02d%02d",
- $day, $mday, $month, $year, $hour, $min, $sec, $direc, $tz_hr, $tz_mi;
-}
-
-sub send {
- my ($self, $report, $recipients) = @_;
- $recipients ||= [];
-
- my $helo = $report->_maildomain(); # XXX: tight -- rjbs, 2008-04-06
- my $from = $report->from();
- my $via = $report->via();
- my @tmprecipients = ();
- my @bad = ();
- my $smtp;
-
- my $mx;
-
- my $transport = $self->_net_class;
-
- # Sorry. Tight coupling happened before I got here. -- rjbs, 2008-04-06
- for my $server (@{$report->{_mx}}) {
- eval {
- $smtp = $transport->new(
- $server,
- Hello => $helo,
- Timeout => $report->timeout(),
- Debug => $report->debug(),
- $report->transport_args(),
- );
- };
-
- if (defined $smtp) {
- $mx = $server;
- last;
- }
- }
-
- die "Unable to connect to any MX's: $@" unless $mx && $smtp;
-
- my $cc_str;
- if (@$recipients) {
- if ($mx =~ /(?:^|\.)(?:perl|cpan)\.org$/) {
- for my $recipient (sort @$recipients) {
- if ($recipient =~ /(?:@|\.)(?:perl|cpan)\.org$/) {
- push @tmprecipients, $recipient;
- } else {
- push @bad, $recipient;
- }
- }
-
- if (@bad) {
- warn __PACKAGE__, ": Will not attempt to cc the following recipients since perl.org MX's will not relay for them. Either use Test::Reporter::Transport::Mail::Send, use other MX's, or only cc address ending in cpan.org or perl.org: ${\(join ', ', @bad)}.\n";
- }
-
- $recipients = \@tmprecipients;
- }
-
- $cc_str = join ', ', @$recipients;
- chomp $cc_str;
- chomp $cc_str;
- }
-
- $via = ', via ' . $via if $via;
-
- my $envelope_sender = $from;
- $envelope_sender =~ s/\s\([^)]+\)$//; # email only; no name
-
- # Net::SMTP returns 1 or undef for pass/fail
- # Net::SMTP::TLS croaks on fail but may not return 1 on pass
- # so this closure lets us die on an undef return only for Net::SMTP
- my $die = sub { die $smtp->message if ref $smtp eq 'Net::SMTP' };
-
- eval {
- $smtp->mail($envelope_sender) or $die->();
- $smtp->to($report->address) or $die->();
- if ( @$recipients ) { $smtp->cc(@$recipients) or $die->() };
- $smtp->data() or $die->();
- $smtp->datasend("Date: ", $self->_format_date, "\n") or $die->();
- $smtp->datasend("Subject: ", $report->subject, "\n") or $die->();
- $smtp->datasend("From: $from\n") or $die->();
- $smtp->datasend("To: ", $report->address, "\n") or $die->();
- if ( @$recipients ) { $smtp->datasend("Cc: $cc_str\n") or $die->() };
- $smtp->datasend("Message-ID: ", $report->message_id(), "\n") or $die->();
- $smtp->datasend("X-Reported-Via: Test::Reporter $Test::Reporter::VERSION$via\n") or $die->();
- $smtp->datasend("\n") or $die->();
- $smtp->datasend($report->report()) or $die->();
- $smtp->dataend() or $die->();
- $smtp->quit or $die->();
- 1;
- } or die "$transport: $@";
-
- return 1;
-}
-
-1;
-
-__END__
-
-=head1 NAME
-
-Test::Reporter::Transport::Net::SMTP - SMTP transport for Test::Reporter
-
-=head1 SYNOPSIS
-
- my $report = Test::Reporter->new(
- transport => 'Net::SMTP',
- );
-
-=head1 DESCRIPTION
-
-This module transmits a Test::Reporter report using Net::SMTP.
-
-=head1 USAGE
-
-See L<Test::Reporter> and L<Test::Reporter::Transport> for general usage
-information.
-
-=head2 Transport Arguments
-
- $report->transport_args( @args );
-
-Any transport arguments are passed through to the Net::SMTP constructer.
-
-=head1 METHODS
-
-These methods are only for internal use by Test::Reporter.
-
-=head2 new
-
- my $sender = Test::Reporter::Transport::Net::SMTP->new( @args );
-
-The C<new> method is the object constructor.
-
-=head2 send
-
- $sender->send( $report );
-
-The C<send> method transmits the report.
-
-=head1 AUTHOR
-
-=over
-
-=item *
-
-David A. Golden (DAGOLDEN)
-
-=item *
-
-Ricardo Signes (RJBS)
-
-=back
-
-=head1 COPYRIGHT
-
- Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008 Adam J. Foxson.
- Copyright (C) 2004, 2005 Richard Soderberg.
- Copyright (C) 2008 David A. Golden
- Copyright (C) 2008 Ricardo Signes
-
- All rights reserved.
-
-=head1 LICENSE
-
-This program is free software; you may redistribute it
-and/or modify it under the same terms as Perl itself.
-
-=cut
-
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Test/Reporter/Transport/Net/SMTP/TLS.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Test/Reporter/Transport/Net/SMTP/TLS.pm
deleted file mode 100644
index 59cf615227f..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Test/Reporter/Transport/Net/SMTP/TLS.pm
+++ /dev/null
@@ -1,86 +0,0 @@
-use strict;
-use warnings;
-package Test::Reporter::Transport::Net::SMTP::TLS;
-use base 'Test::Reporter::Transport::Net::SMTP';
-use vars qw/$VERSION/;
-$VERSION = '1.4002';
-$VERSION = eval $VERSION;
-
-use Net::SMTP::TLS;
-
-1;
-
-__END__
-
-=head1 NAME
-
-Test::Reporter::Transport::Net::SMTP::TLS - Authenticated SMTP transport for Test::Reporter
-
-=head1 SYNOPSIS
-
- my $report = Test::Reporter->new(
- transport => 'Net::SMTP::TLS',
- transport_args => [ User => 'Joe', Password => '123' ],
- );
-
-=head1 DESCRIPTION
-
-This module transmits a Test::Reporter report using Net::SMTP::TLS.
-
-=head1 USAGE
-
-See L<Test::Reporter> and L<Test::Reporter::Transport> for general usage
-information.
-
-=head2 Transport Arguments
-
- $report->transport_args( @args );
-
-Any transport arguments are passed through to the Net::SMTP::TLS constructer.
-
-=head1 METHODS
-
-These methods are only for internal use by Test::Reporter.
-
-=head2 new
-
- my $sender = Test::Reporter::Transport::Net::SMTP::TLS->new(
- @args
- );
-
-The C<new> method is the object constructor.
-
-=head2 send
-
- $sender->send( $report );
-
-The C<send> method transmits the report.
-
-=head1 AUTHOR
-
-=over
-
-=item *
-
-David A. Golden (DAGOLDEN)
-
-=item *
-
-Ricardo Signes (RJBS)
-
-=back
-
-=head1 COPYRIGHT
-
- Copyright (C) 2008 David A. Golden
- Copyright (C) 2008 Ricardo Signes
-
- All rights reserved.
-
-=head1 LICENSE
-
-This program is free software; you may redistribute it
-and/or modify it under the same terms as Perl itself.
-
-=cut
-
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Test/YAML.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Test/YAML.pm
deleted file mode 100644
index 38e57e69562..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Test/YAML.pm
+++ /dev/null
@@ -1,268 +0,0 @@
-package Test::YAML;
-use Test::Base 0.47 -Base;
-use lib 'lib';
-
-our $VERSION = '0.57';
-
-our $YAML = 'YAML';
-
-our @EXPORT = qw(
- no_diff
- run_yaml_tests
- run_roundtrip_nyn roundtrip_nyn
- run_load_passes load_passes
- dumper Load Dump LoadFile DumpFile
- XXX
-);
-
-delimiters('===', '+++');
-
-sub Dump() { YAML(Dump => @_) }
-sub Load() { YAML(Load => @_) }
-sub DumpFile() { YAML(DumpFile => @_) }
-sub LoadFile() { YAML(LoadFile => @_) }
-
-sub YAML() {
- load_yaml_pm();
- my $meth = shift;
- my $code = $YAML->can($meth) or die "$YAML cannot do $meth";
- goto &$code;
-}
-
-sub load_yaml_pm {
- my $file = "$YAML.pm";
- $file =~ s{::}{/}g;
- require $file;
-}
-
-sub run_yaml_tests() {
- run {
- my $block = shift;
- &{_get_function($block)}($block) unless
- _skip_tests_for_now($block) or
- _skip_yaml_tests($block);
- };
-}
-
-sub run_roundtrip_nyn() {
- my @options = @_;
- run {
- my $block = shift;
- roundtrip_nyn($block, @options);
- };
-}
-
-sub roundtrip_nyn() {
- my $block = shift;
- my $option = shift || '';
- die "'perl' data section required"
- unless exists $block->{perl};
- my @values = eval $block->perl;
- die "roundtrip_nyn eval perl error: $@" if $@;
- my $config = $block->config || '';
- my $result = eval "$config; Dump(\@values)";
- die "roundtrip_nyn YAML::Dump error: $@" if $@;
- if (exists $block->{yaml}) {
- is $result, $block->yaml,
- $block->description . ' (n->y)';
- }
- else {
- pass $block->description . ' (n->y)';
- }
-
- return if exists $block->{no_round_trip} or
- not exists $block->{yaml};
-
- if ($option eq 'dumper') {
- is dumper(Load($block->yaml)), dumper(@values),
- $block->description . ' (y->n)';
- }
- else {
- is_deeply [Load($block->yaml)], [@values],
- $block->description . ' (y->n)';
- }
-}
-
-sub count_roundtrip_nyn() {
- my $block = shift or die "Bad call to count_roundtrip_nyn";
- return 1 if exists $block->{skip_this_for_now};
- my $count = 0;
- $count++ if exists $block->{perl};
- $count++ unless exists $block->{no_round_trip} or
- not exists $block->{yaml};
- die "Invalid test definition" unless $count;
- return $count;
-}
-
-sub run_load_passes() {
- run {
- my $block = shift;
- my $yaml = $block->yaml;
- eval { YAML(Load => $yaml) };
- is("$@", "");
- };
-}
-
-sub load_passes() {
- my $block = shift;
- my $yaml = $block->yaml;
- eval { YAML(Load => $yaml) };
- is "$@", "", $block->description;
-}
-
-sub count_load_passes() {1}
-
-sub dumper() {
- require Data::Dumper;
- $Data::Dumper::Sortkeys = 1;
- $Data::Dumper::Terse = 1;
- $Data::Dumper::Indent = 1;
- return Data::Dumper::Dumper(@_);
-}
-
-{
- no warnings;
- sub XXX {
- YAML::Base::XXX(@_);
- }
-}
-
-sub _count_tests() {
- my $block = shift or die "Bad call to _count_tests";
- no strict 'refs';
- &{'count_' . _get_function_name($block)}($block);
-}
-
-sub _get_function_name() {
- my $block = shift;
- return $block->function || 'roundtrip_nyn';
-}
-
-sub _get_function() {
- my $block = shift;
- no strict 'refs';
- \ &{_get_function_name($block)};
-}
-
-sub _skip_tests_for_now() {
- my $block = shift;
- if (exists $block->{skip_this_for_now}) {
- _skip_test(
- $block->description,
- _count_tests($block),
- );
- return 1;
- }
- return 0;
-}
-
-sub _skip_yaml_tests() {
- my $block = shift;
- if ($block->skip_unless_modules) {
- my @modules = split /[\s\,]+/, $block->skip_unless_modules;
- for my $module (@modules) {
- eval "require $module";
- if ($@) {
- _skip_test(
- "This test requires the '$module' module",
- _count_tests($block),
- );
- return 1;
- }
- }
- }
- return 0;
-}
-
-sub _skip_test() {
- my ($message, $count) = @_;
- SKIP: {
- skip($message, $count);
- }
-}
-
-#-------------------------------------------------------------------------------
-package Test::YAML::Filter;
-use base 'Test::Base::Filter';
-
-sub yaml_dump {
- Test::YAML::Dump(@_);
-}
-
-sub yaml_load {
- Test::YAML::Load(@_);
-}
-
-sub Dump { goto &Test::YAML::Dump }
-sub Load { goto &Test::YAML::Load }
-sub DumpFile { goto &Test::YAML::DumpFile }
-sub LoadFile { goto &Test::YAML::LoadFile }
-
-sub yaml_load_or_fail {
- my ($result, $error, $warning) =
- $self->_yaml_load_result_error_warning(@_);
- return $error || $result;
-}
-
-sub yaml_load_error_or_warning {
- my ($result, $error, $warning) =
- $self->_yaml_load_result_error_warning(@_);
- return $error || $warning || '';
-}
-
-sub perl_eval_error_or_warning {
- my ($result, $error, $warning) =
- $self->_perl_eval_result_error_warning(@_);
- return $error || $warning || '';
-}
-
-sub _yaml_load_result_error_warning {
- $self->assert_scalar(@_);
- my $yaml = shift;
- my $warning = '';
- local $SIG{__WARN__} = sub { $warning = join '', @_ };
- my $result = eval {
- $self->yaml_load($yaml);
- };
- return ($result, $@, $warning);
-}
-
-sub _perl_eval_result_error_warning {
- $self->assert_scalar(@_);
- my $perl = shift;
- my $warning = '';
- local $SIG{__WARN__} = sub { $warning = join '', @_ };
- my $result = eval $perl;
- return ($result, $@, $warning);
-}
-
-1;
-
-=head1 NAME
-
-Test::YAML - Testing Module for YAML Implementations
-
-=head1 SYNOPSIS
-
- use Test::YAML tests => 1;
-
- pass;
-
-=head1 DESCRIPTION
-
-Test::YAML is a subclass of Test::Base with YAML specific support.
-
-=head1 AUTHOR
-
-Ingy döt Net <ingy@cpan.org>
-
-=head1 COPYRIGHT
-
-Copyright (c) 2006. Ingy döt Net. All rights reserved.
-
-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/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI.pm
deleted file mode 100644
index 9f2524aa279..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI.pm
+++ /dev/null
@@ -1,1021 +0,0 @@
-package URI;
-
-use strict;
-use vars qw($VERSION);
-$VERSION = "1.36";
-
-use vars qw($ABS_REMOTE_LEADING_DOTS $ABS_ALLOW_RELATIVE_SCHEME);
-
-my %implements; # mapping from scheme to implementor class
-
-# Some "official" character classes
-
-use vars qw($reserved $mark $unreserved $uric $scheme_re);
-$reserved = q(;/?:@&=+$,[]);
-$mark = q(-_.!~*'()); #'; emacs
-$unreserved = "A-Za-z0-9\Q$mark\E";
-$uric = quotemeta($reserved) . $unreserved . "%";
-
-$scheme_re = '[a-zA-Z][a-zA-Z0-9.+\-]*';
-
-use Carp ();
-use URI::Escape ();
-
-use overload ('""' => sub { ${$_[0]} },
- '==' => sub { overload::StrVal($_[0]) eq
- overload::StrVal($_[1])
- },
- fallback => 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 =~ s*([^$uric\#])* URI::Escape::escape_char($1) *ego;
- $str = "$scheme:$str" unless $str =~ /^$scheme_re:/o ||
- $class->_no_scheme_ok;
- my $self = bless \$str, $class;
- $self;
-}
-
-
-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 tranformation...
- $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"}) {
- # Try to load it
- eval "require $ic";
- die $@ if $@ && $@ !~ /Can\'t locate.*in \@INC/;
- return 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 _no_scheme_ok { 0 }
-
-sub _scheme
-{
- my $self = shift;
-
- unless (@_) {
- return 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 unless defined $scheme;
- lc($scheme);
-}
-
-
-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;
-
- $$self = defined($old_scheme) ? $old_scheme : "";
- $$self .= $new_opaque;
- $$self .= $old_frag if defined $old_frag;
-
- $old_opaque;
-}
-
-*path = \&opaque; # alias
-
-
-sub fragment
-{
- my $self = shift;
- unless (@_) {
- return 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;
- $$self .= "#$new_frag";
- }
- $old;
-}
-
-
-sub as_string
-{
- my $self = shift;
- $$self;
-}
-
-
-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]; }
-
-# 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
-
- $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.
-
-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 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->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 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->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.
-
-=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. Unknown 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( \@key_value_pairs )
-
-=item $uri->query_form( \%hash )
-
-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 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.
-
-=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: ":".
-
-=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.
-
-=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 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 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<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
-<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"
-
-=back
-
-=head1 BUGS
-
-Using regexp variables like $1 directly as arguments to the URI 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");
-
-=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.
-
-http://www.iana.org/assignments/uri-schemes
-
-http://www.iana.org/assignments/urn-namespaces
-
-http://www.w3.org/Addressing/
-
-=head1 COPYRIGHT
-
-Copyright 1995-2004,2008 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/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/Escape.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/Escape.pm
deleted file mode 100644
index c2d26ec32f4..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/Escape.pm
+++ /dev/null
@@ -1,218 +0,0 @@
-package URI::Escape;
-use strict;
-
-=head1 NAME
-
-URI::Escape - Escape and unescape 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 escape and unescape URI strings as
-defined by RFC 2396 (and updated by RFC 2732).
-A URI consists of a restricted set of characters,
-denoted as C<uric> in RFC 2396. 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:
-
- "A" .. "Z", "a" .. "z", "0" .. "9",
- ";", "/", "?", ":", "@", "&", "=", "+", "$", ",", "[", "]", # 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 (iff the
-character is part of C<uric>).
-
-Some of the C<uric> 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 2396 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<uric> 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 do 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.
-
-The call:
-
- $uri = uri_escape_utf8($string);
-
-will be the same as:
-
- use Encode qw(encode);
- $uri = uri_escape(encode("UTF-8", $string));
-
-but will even work for perl-5.6 for chars in the 128 .. 255 range.
-
-Note: Javascript has a function called escape() that produce 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 encodeURI() 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 vars qw(@ISA @EXPORT @EXPORT_OK $VERSION);
-use vars qw(%escapes);
-
-require Exporter;
-@ISA = qw(Exporter);
-@EXPORT = qw(uri_escape uri_unescape uri_escape_utf8);
-@EXPORT_OK = qw(%escapes);
-$VERSION = "3.29";
-
-use Carp ();
-
-# Build a char->hex map
-for (0..255) {
- $escapes{chr($_)} = sprintf("%%%02X", $_);
-}
-
-my %subst; # compiled patternes
-
-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 {
- # Default unsafe characters. RFC 2732 ^(uric - reserved)
- $text =~ s/([^A-Za-z0-9\-_.!~*'()])/$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;
- if ($] < 5.008) {
- $text =~ s/([^\0-\x7F])/do {my $o = ord($1); sprintf("%c%c", 0xc0 | ($o >> 6), 0x80 | ($o & 0x3f)) }/ge;
- }
- else {
- 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
- foreach (@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;
-}
-
-sub escape_char {
- return join '', @URI::Escape::escapes{$_[0] =~ /(\C)/g};
-}
-
-1;
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/Heuristic.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/Heuristic.pm
deleted file mode 100644
index 7c91eedce9e..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/Heuristic.pm
+++ /dev/null
@@ -1,222 +0,0 @@
-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 two 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 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 vars qw(@EXPORT_OK $VERSION $MY_COUNTRY %LOCAL_GUESSING $DEBUG);
-
-require Exporter;
-*import = \&Exporter::import;
-@EXPORT_OK = qw(uf_uri uf_uristr uf_url uf_urlstr);
-$VERSION = "4.18";
-
-sub MY_COUNTRY() {
- for ($MY_COUNTRY) {
- return $_ if defined;
-
- # First try the environment.
- $_ = $ENV{COUNTRY};
- return $_ if defined;
-
- # Could use LANG, LC_ALL, etc at this point, but probably too
- # much of a wild guess. (Catalan != Canada, etc.)
- #
-
- # 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);
- }
-}
-
-%LOCAL_GUESSING =
-(
- 'us' => [qw(www.ACME.gov www.ACME.mil)],
- 'uk' => [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>
-);
-
-
-sub uf_uristr ($)
-{
- local($_) = @_;
- print STDERR "uf_uristr: resolving $_\n" if $DEBUG;
- return unless defined;
-
- s/^\s+//;
- s/\s+$//;
-
- if (/^(www|web|home)\./) {
- $_ = "http://$_";
-
- } elsif (/^(ftp|gopher|news|wais|http|https)\./) {
- $_ = "$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;
-
- 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;
- }
- }
- $_ = "http://$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/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/QueryParam.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/QueryParam.pm
deleted file mode 100644
index 225ca6e371a..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/QueryParam.pm
+++ /dev/null
@@ -1,200 +0,0 @@
-package URI::QueryParam;
-
-use strict;
-
-sub URI::_query::query_param {
- my $self = shift;
- my @old = $self->query_form;
-
- if (@_ == 0) {
- # get keys
- my %seen;
- my @keys;
- for (my $i = 0; $i < @old; $i += 2) {
- push(@keys, $old[$i]) unless $seen{$old[$i]}++;
- }
- return @keys;
- }
-
- my $key = shift;
- my @i;
-
- for (my $i = 0; $i < @old; $i += 2) {
- push(@i, $i) if $old[$i] eq $key;
- }
-
- if (@_) {
- my @new = @old;
- my @new_i = @i;
- my @vals = map { ref($_) eq 'ARRAY' ? @$_ : $_ } @_;
- #print "VALS:@vals [@i]\n";
- while (@new_i > @vals) {
- #print "REMOVE $new_i[-1]\n";
- splice(@new, pop(@new_i), 2);
- }
- while (@vals > @new_i) {
- my $i = @new_i ? $new_i[-1] + 2 : @new;
- #print "SPLICE $i\n";
- splice(@new, $i, 0, $key => pop(@vals));
- }
- for (@vals) {
- #print "SET $new_i[0]\n";
- $new[shift(@new_i)+1] = $_;
- }
-
- $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;
- $self->query_form($self->query_form, $key => \@_); # 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.
-
-=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/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/Split.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/Split.pm
deleted file mode 100644
index ad430b93277..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/Split.pm
+++ /dev/null
@@ -1,96 +0,0 @@
-package URI::Split;
-
-use strict;
-
-use vars qw(@ISA @EXPORT_OK);
-require Exporter;
-@ISA = qw(Exporter);
-@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/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/URL.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/URL.pm
deleted file mode 100644
index 77354488c86..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/URL.pm
+++ /dev/null
@@ -1,305 +0,0 @@
-package URI::URL;
-
-require URI::WithBase;
-@ISA=qw(URI::WithBase);
-
-use strict;
-use vars qw(@EXPORT $VERSION);
-
-$VERSION = "5.03";
-
-# Provide as much as possible of the old URI::URL interface for backwards
-# compatibility...
-
-require Exporter;
-*import = \&Exporter::import;
-@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 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 loosing
- # 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/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/WithBase.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/WithBase.pm
deleted file mode 100644
index 0337c6b6450..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/WithBase.pm
+++ /dev/null
@@ -1,171 +0,0 @@
-package URI::WithBase;
-
-use strict;
-use vars qw($AUTOLOAD $VERSION);
-use URI;
-
-$VERSION = "2.19";
-
-use overload '""' => "as_string", fallback => 1;
-
-sub as_string; # help overload find it
-
-sub new
-{
- my($class, $uri, $base) = @_;
- my $ibase = $base;
- if ($base && ref($base) && UNIVERSAL::isa($base, __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 UNIVERSAL::isa($other, __PACKAGE__);
- $self->[0]->eq($other);
-}
-
-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/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/_foreign.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/_foreign.pm
deleted file mode 100644
index 075f0fd3417..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/_foreign.pm
+++ /dev/null
@@ -1,6 +0,0 @@
-package URI::_foreign;
-
-require URI::_generic;
-@ISA=qw(URI::_generic);
-
-1;
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/_generic.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/_generic.pm
deleted file mode 100644
index 2a02332853c..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/_generic.pm
+++ /dev/null
@@ -1,249 +0,0 @@
-package URI::_generic;
-require URI;
-require URI::_query;
-@ISA=qw(URI URI::_query);
-
-use strict;
-use URI::Escape qw(uri_unescape);
-use Carp ();
-
-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;
- $$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;
- _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;
- _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;
- $abs->fragment($self->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 oposite 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/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/_ldap.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/_ldap.pm
deleted file mode 100644
index 608dbd339a3..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/_ldap.pm
+++ /dev/null
@@ -1,140 +0,0 @@
-# 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 vars qw($VERSION);
-$VERSION = "1.10";
-
-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 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 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);
-
- # Lowecase 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/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/_login.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/_login.pm
deleted file mode 100644
index 4583f20a9a6..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/_login.pm
+++ /dev/null
@@ -1,10 +0,0 @@
-package URI::_login;
-
-require URI::_server;
-require URI::_userpass;
-@ISA = qw(URI::_server URI::_userpass);
-
-# Generic terminal logins. This is used as a base class for 'telnet',
-# 'tn3270', and 'rlogin' URL schemes.
-
-1;
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/_query.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/_query.pm
deleted file mode 100644
index cb9abc18206..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/_query.pm
+++ /dev/null
@@ -1,81 +0,0 @@
-package URI::_query;
-
-use strict;
-use URI ();
-use URI::Escape qw(uri_unescape);
-
-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;
- $$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 @new = @_;
- if (@new == 1) {
- my $n = $new[0];
- if (ref($n) eq "ARRAY") {
- @new = @$n;
- }
- elsif (ref($n) eq "HASH") {
- @new = %$n;
- }
- }
- my @query;
- while (my($key,$vals) = splice(@new, 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");
- }
- }
- $self->query(@query ? join('&', @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
-*equery = \&query;
-
-1;
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/_segment.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/_segment.pm
deleted file mode 100644
index c91b69608e3..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/_segment.pm
+++ /dev/null
@@ -1,20 +0,0 @@
-package URI::_segment;
-
-# Represents a generic path_segment so that it can be treated as
-# a string too.
-
-use strict;
-use URI::Escape qw(uri_unescape);
-
-use overload '""' => sub { $_[0]->[0] },
- fallback => 1;
-
-sub new
-{
- my $class = shift;
- my @segment = split(';', shift, -1);
- $segment[0] = uri_unescape($segment[0]);
- bless \@segment, $class;
-}
-
-1;
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/_server.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/_server.pm
deleted file mode 100644
index 10059f0c6f5..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/_server.pm
+++ /dev/null
@@ -1,106 +0,0 @@
-package URI::_server;
-require URI::_generic;
-@ISA=qw(URI::_generic);
-
-use strict;
-use URI::Escape qw(uri_unescape);
-
-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 @
- $port = $1 if $new =~ s/(:\d+)$//;
- }
- $self->authority("$ui$new$port");
- }
- return undef unless defined $old;
- $old =~ s/.*@//;
- $old =~ s/:\d+$//;
- return uri_unescape($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 does not could
- $old .= ":" . $self->port unless $old =~ /:/;
- $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/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/_userpass.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/_userpass.pm
deleted file mode 100644
index a0361ae0dd7..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/_userpass.pm
+++ /dev/null
@@ -1,51 +0,0 @@
-package URI::_userpass;
-
-use strict;
-use URI::Escape qw(uri_unescape);
-
-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 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 unless defined $info;
- return unless $info =~ s/^[^:]*://;
- uri_unescape($info);
-}
-
-1;
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/data.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/data.pm
deleted file mode 100644
index dccd8181289..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/data.pm
+++ /dev/null
@@ -1,140 +0,0 @@
-package URI::data; # RFC 2397
-
-require URI;
-@ISA=qw(URI);
-
-use strict;
-
-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/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/file.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/file.pm
deleted file mode 100644
index 3db4c4b78c3..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/file.pm
+++ /dev/null
@@ -1,329 +0,0 @@
-package URI::file;
-
-use strict;
-use vars qw(@ISA $VERSION $DEFAULT_AUTHORITY %OS_CLASS);
-
-require URI::_generic;
-@ISA = qw(URI::_generic);
-$VERSION = "4.20";
-
-use URI::Escape qw(uri_unescape);
-
-$DEFAULT_AUTHORITY = "";
-
-# Map from $^O values to implementation classes. The Unix
-# class is the default.
-%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 path { shift->path_query(@_) }
-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 uses ":" as path separator, but not in the same way
-as a generic URI. ":foo" is a relative name. "foo:bar" is an absolute
-name. Also, path segments can contain the "/" character as well as the
-literal "." or "..". So the mapping looks like this:
-
- Mac 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
- distribted 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/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/file/Base.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/file/Base.pm
deleted file mode 100644
index 941793b0f93..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/file/Base.pm
+++ /dev/null
@@ -1,80 +0,0 @@
-package URI::file::Base;
-
-use strict;
-use URI::Escape qw();
-
-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/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/file/FAT.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/file/FAT.pm
deleted file mode 100644
index 328169bd0bf..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/file/FAT.pm
+++ /dev/null
@@ -1,23 +0,0 @@
-package URI::file::FAT;
-
-require URI::file::Win32;
-@ISA=qw(URI::file::Win32);
-
-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/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/file/Mac.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/file/Mac.pm
deleted file mode 100644
index 6cfa78192e0..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/file/Mac.pm
+++ /dev/null
@@ -1,120 +0,0 @@
-package URI::file::Mac;
-
-require URI::file::Base;
-@ISA=qw(URI::file::Base);
-
-use strict;
-use URI::Escape qw(uri_unescape);
-
-
-
-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/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/file/OS2.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/file/OS2.pm
deleted file mode 100644
index ad0a78ede52..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/file/OS2.pm
+++ /dev/null
@@ -1,28 +0,0 @@
-package URI::file::OS2;
-
-require URI::file::Win32;
-@ISA=qw(URI::file::Win32);
-
-# 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/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/file/QNX.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/file/QNX.pm
deleted file mode 100644
index 93a4983d2bb..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/file/QNX.pm
+++ /dev/null
@@ -1,18 +0,0 @@
-package URI::file::QNX;
-
-require URI::file::Unix;
-@ISA=qw(URI::file::Unix);
-
-use strict;
-
-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/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/file/Unix.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/file/Unix.pm
deleted file mode 100644
index 5f8aaae9050..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/file/Unix.pm
+++ /dev/null
@@ -1,55 +0,0 @@
-package URI::file::Unix;
-
-require URI::file::Base;
-@ISA=qw(URI::file::Base);
-
-use strict;
-use URI::Escape qw(uri_unescape);
-
-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/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/file/Win32.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/file/Win32.pm
deleted file mode 100644
index 04593863a92..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/file/Win32.pm
+++ /dev/null
@@ -1,84 +0,0 @@
-package URI::file::Win32;
-
-require URI::file::Base;
-@ISA=qw(URI::file::Base);
-
-use strict;
-use URI::Escape qw(uri_unescape);
-
-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/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/ftp.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/ftp.pm
deleted file mode 100644
index 89aeb07cdc9..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/ftp.pm
+++ /dev/null
@@ -1,45 +0,0 @@
-package URI::ftp;
-
-require URI::_server;
-require URI::_userpass;
-@ISA=qw(URI::_server URI::_userpass);
-
-use strict;
-
-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/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/gopher.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/gopher.pm
deleted file mode 100644
index ae6690423bc..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/gopher.pm
+++ /dev/null
@@ -1,94 +0,0 @@
-package URI::gopher; # <draft-murali-url-gopher>, Dec 4, 1996
-
-require URI::_server;
-@ISA=qw(URI::_server);
-
-use strict;
-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;
-}
-
-*gtype = \&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/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/http.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/http.pm
deleted file mode 100644
index cb698224060..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/http.pm
+++ /dev/null
@@ -1,25 +0,0 @@
-package URI::http;
-
-require URI::_server;
-@ISA=qw(URI::_server);
-
-use strict;
-
-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/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/https.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/https.pm
deleted file mode 100644
index c39c67b5ec3..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/https.pm
+++ /dev/null
@@ -1,7 +0,0 @@
-package URI::https;
-require URI::http;
-@ISA=qw(URI::http);
-
-sub default_port { 443 }
-
-1;
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/ldap.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/ldap.pm
deleted file mode 100644
index 8af504b269d..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/ldap.pm
+++ /dev/null
@@ -1,122 +0,0 @@
-# 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 vars qw(@ISA $VERSION);
-$VERSION = "1.11";
-
-require URI::_server;
-require URI::_ldap;
-@ISA=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<RFC-2255|http://www.cis.ohio-state.edu/htbin/rfc/rfc2255.html>
-
-=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/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/ldapi.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/ldapi.pm
deleted file mode 100644
index d92b13f3a49..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/ldapi.pm
+++ /dev/null
@@ -1,30 +0,0 @@
-package URI::ldapi;
-
-use strict;
-
-use vars qw(@ISA);
-
-require URI::_generic;
-require URI::_ldap;
-@ISA=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/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/ldaps.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/ldaps.pm
deleted file mode 100644
index 20180d55773..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/ldaps.pm
+++ /dev/null
@@ -1,7 +0,0 @@
-package URI::ldaps;
-require URI::ldap;
-@ISA=qw(URI::ldap);
-
-sub default_port { 636 }
-
-1;
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/mailto.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/mailto.pm
deleted file mode 100644
index 88761c40333..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/mailto.pm
+++ /dev/null
@@ -1,72 +0,0 @@
-package URI::mailto; # RFC 2368
-
-require URI;
-require URI::_query;
-@ISA=qw(URI URI::_query);
-
-use strict;
-
-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/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/mms.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/mms.pm
deleted file mode 100644
index 2f1015b61d9..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/mms.pm
+++ /dev/null
@@ -1,8 +0,0 @@
-package URI::mms;
-
-require URI::http;
-@ISA=qw(URI::http);
-
-sub default_port { 1755 }
-
-1;
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/news.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/news.pm
deleted file mode 100644
index 1ffb419f673..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/news.pm
+++ /dev/null
@@ -1,68 +0,0 @@
-package URI::news; # draft-gilman-news-url-01
-
-require URI::_server;
-@ISA=qw(URI::_server);
-
-use strict;
-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 unless $old =~ /\@/;
- return $old;
-}
-
-1;
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/nntp.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/nntp.pm
deleted file mode 100644
index af61e036cc7..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/nntp.pm
+++ /dev/null
@@ -1,6 +0,0 @@
-package URI::nntp; # draft-gilman-news-url-01
-
-require URI::news;
-@ISA=qw(URI::news);
-
-1;
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/pop.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/pop.pm
deleted file mode 100644
index 50b8d6dd511..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/pop.pm
+++ /dev/null
@@ -1,68 +0,0 @@
-package URI::pop; # RFC 2384
-
-require URI::_server;
-@ISA=qw(URI::_server);
-
-use strict;
-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 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 unless defined $old;
- $old =~ s/^[^;]*//;
- return uri_unescape($1) if $old =~ /;auth=(.*)/i;
- return;
-}
-
-1;
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/rlogin.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/rlogin.pm
deleted file mode 100644
index 18bb76272a4..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/rlogin.pm
+++ /dev/null
@@ -1,7 +0,0 @@
-package URI::rlogin;
-require URI::_login;
-@ISA = qw(URI::_login);
-
-sub default_port { 513 }
-
-1;
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/rsync.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/rsync.pm
deleted file mode 100644
index 160d9d0c065..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/rsync.pm
+++ /dev/null
@@ -1,12 +0,0 @@
-package URI::rsync; # http://rsync.samba.org/
-
-# rsync://[USER@]HOST[:PORT]/SRC
-
-require URI::_server;
-require URI::_userpass;
-
-@ISA=qw(URI::_server URI::_userpass);
-
-sub default_port { 873 }
-
-1;
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/rtsp.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/rtsp.pm
deleted file mode 100644
index 982ca5ebf1e..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/rtsp.pm
+++ /dev/null
@@ -1,8 +0,0 @@
-package URI::rtsp;
-
-require URI::http;
-@ISA=qw(URI::http);
-
-sub default_port { 554 }
-
-1;
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/rtspu.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/rtspu.pm
deleted file mode 100644
index dbcf12bb2f4..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/rtspu.pm
+++ /dev/null
@@ -1,8 +0,0 @@
-package URI::rtspu;
-
-require URI::rtsp;
-@ISA=qw(URI::rtsp);
-
-sub default_port { 554 }
-
-1;
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/sip.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/sip.pm
deleted file mode 100644
index 1ace52c4f58..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/sip.pm
+++ /dev/null
@@ -1,86 +0,0 @@
-#
-# 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;
-
-require URI::_server;
-require URI::_userpass;
-@ISA=qw(URI::_server URI::_userpass);
-
-use strict;
-use vars qw(@ISA $VERSION);
-use URI::Escape qw(uri_unescape);
-
-$VERSION = "0.10";
-
-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/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/sips.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/sips.pm
deleted file mode 100644
index b32e105e24b..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/sips.pm
+++ /dev/null
@@ -1,7 +0,0 @@
-package URI::sips;
-require URI::sip;
-@ISA=qw(URI::sip);
-
-sub default_port { 5061 }
-
-1;
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/snews.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/snews.pm
deleted file mode 100644
index 7e5b0379e15..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/snews.pm
+++ /dev/null
@@ -1,8 +0,0 @@
-package URI::snews; # draft-gilman-news-url-01
-
-require URI::news;
-@ISA=qw(URI::news);
-
-sub default_port { 563 }
-
-1;
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/ssh.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/ssh.pm
deleted file mode 100644
index 5cd30fc3bfc..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/ssh.pm
+++ /dev/null
@@ -1,9 +0,0 @@
-package URI::ssh;
-require URI::_login;
-@ISA=qw(URI::_login);
-
-# ssh://[USER@]HOST[:PORT]/SRC
-
-sub default_port { 22 }
-
-1;
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/telnet.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/telnet.pm
deleted file mode 100644
index 5f842d35787..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/telnet.pm
+++ /dev/null
@@ -1,7 +0,0 @@
-package URI::telnet;
-require URI::_login;
-@ISA = qw(URI::_login);
-
-sub default_port { 23 }
-
-1;
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/tn3270.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/tn3270.pm
deleted file mode 100644
index dd1e648e713..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/tn3270.pm
+++ /dev/null
@@ -1,7 +0,0 @@
-package URI::tn3270;
-require URI::_login;
-@ISA = qw(URI::_login);
-
-sub default_port { 23 }
-
-1;
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/urn.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/urn.pm
deleted file mode 100644
index 12d40b265bc..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/urn.pm
+++ /dev/null
@@ -1,97 +0,0 @@
-package URI::urn; # RFC 2141
-
-require URI;
-@ISA=qw(URI);
-
-use strict;
-use Carp qw(carp);
-
-use vars qw(%implementor);
-
-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"}) {
- # Try to load it
- eval "require $impclass";
- die $@ if $@ && $@ !~ /Can\'t locate.*in \@INC/;
- $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/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/urn/isbn.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/urn/isbn.pm
deleted file mode 100644
index 0da931bfb69..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/urn/isbn.pm
+++ /dev/null
@@ -1,102 +0,0 @@
-package URI::urn::isbn; # RFC 3187
-
-require URI::urn;
-@ISA=qw(URI::urn);
-
-use strict;
-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/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/urn/oid.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/urn/oid.pm
deleted file mode 100644
index 301b2bcd834..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/URI/urn/oid.pm
+++ /dev/null
@@ -1,18 +0,0 @@
-package URI::urn::oid; # RFC 2061
-
-require URI::urn;
-@ISA=qw(URI::urn);
-
-use strict;
-
-sub oid {
- my $self = shift;
- my $old = $self->nss;
- if (@_) {
- $self->nss(join(".", @_));
- }
- return split(/\./, $old) if wantarray;
- return $old;
-}
-
-1;
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/WWW/RobotRules.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/WWW/RobotRules.pm
deleted file mode 100644
index 428fdde4d95..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/WWW/RobotRules.pm
+++ /dev/null
@@ -1,444 +0,0 @@
-package WWW::RobotRules;
-
-$VERSION = "5.810";
-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);
- }
- }
- else {
- warn "RobotRules <$robot_txt_uri>: Unexpected line: $_\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) {
- LWP::Debug::debug("\"$ua_line\" applies to \"$me\"")
- if defined &LWP::Debug::debug;
- return 1;
- }
- else {
- LWP::Debug::debug("\"$ua_line\" does not apply to \"$me\"")
- if defined &LWP::Debug::debug;
- 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
-
-=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>
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/WWW/RobotRules/AnyDBM_File.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/WWW/RobotRules/AnyDBM_File.pm
deleted file mode 100644
index 415a3239a88..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/WWW/RobotRules/AnyDBM_File.pm
+++ /dev/null
@@ -1,170 +0,0 @@
-package WWW::RobotRules::AnyDBM_File;
-
-require WWW::RobotRules;
-@ISA = qw(WWW::RobotRules);
-$VERSION = "5.810";
-
-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 = new WWW::RobotRules::AnyDBM_File 'my-robot/1.0', 'cachefile';
- my $ua = new WWW::RobotUA '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/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/XML/NamespaceSupport.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/XML/NamespaceSupport.pm
deleted file mode 100644
index 2c3fe54d576..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/XML/NamespaceSupport.pm
+++ /dev/null
@@ -1,583 +0,0 @@
-
-###
-# XML::NamespaceSupport - a simple generic namespace processor
-# Robin Berjon <robin@knowscape.com>
-###
-
-package XML::NamespaceSupport;
-use strict;
-use constant FATALS => 0; # root object
-use constant NSMAP => 1;
-use constant UNKNOWN_PREF => 2;
-use constant AUTO_PREFIX => 3;
-use constant XMLNS_11 => 4;
-use constant DEFAULT => 0; # maps
-use constant PREFIX_MAP => 1;
-use constant DECLARATIONS => 2;
-
-use vars qw($VERSION $NS_XMLNS $NS_XML);
-$VERSION = '1.09';
-$NS_XMLNS = 'http://www.w3.org/2000/xmlns/';
-$NS_XML = 'http://www.w3.org/XML/1998/namespace';
-
-
-# add the ns stuff that baud wants based on Java's xml-writer
-
-
-#-------------------------------------------------------------------#
-# constructor
-#-------------------------------------------------------------------#
-sub new {
- my $class = ref($_[0]) ? ref(shift) : shift;
- my $options = shift;
- my $self = [
- 1, # FATALS
- [[ # NSMAP
- undef, # DEFAULT
- { xml => $NS_XML }, # PREFIX_MAP
- undef, # DECLARATIONS
- ]],
- 'aaa', # UNKNOWN_PREF
- 0, # AUTO_PREFIX
- 1, # XML_11
- ];
- $self->[NSMAP]->[0]->[PREFIX_MAP]->{xmlns} = $NS_XMLNS if $options->{xmlns};
- $self->[FATALS] = $options->{fatal_errors} if defined $options->{fatal_errors};
- $self->[AUTO_PREFIX] = $options->{auto_prefix} if defined $options->{auto_prefix};
- $self->[XMLNS_11] = $options->{xmlns_11} if defined $options->{xmlns_11};
- return bless $self, $class;
-}
-#-------------------------------------------------------------------#
-
-#-------------------------------------------------------------------#
-# reset() - return to the original state (for reuse)
-#-------------------------------------------------------------------#
-sub reset {
- my $self = shift;
- $#{$self->[NSMAP]} = 0;
-}
-#-------------------------------------------------------------------#
-
-#-------------------------------------------------------------------#
-# push_context() - add a new empty context to the stack
-#-------------------------------------------------------------------#
-sub push_context {
- my $self = shift;
- push @{$self->[NSMAP]}, [
- $self->[NSMAP]->[-1]->[DEFAULT],
- { %{$self->[NSMAP]->[-1]->[PREFIX_MAP]} },
- [],
- ];
-}
-#-------------------------------------------------------------------#
-
-#-------------------------------------------------------------------#
-# pop_context() - remove the topmost context fromt the stack
-#-------------------------------------------------------------------#
-sub pop_context {
- my $self = shift;
- die 'Trying to pop context without push context' unless @{$self->[NSMAP]} > 1;
- pop @{$self->[NSMAP]};
-}
-#-------------------------------------------------------------------#
-
-#-------------------------------------------------------------------#
-# declare_prefix() - declare a prefix in the current scope
-#-------------------------------------------------------------------#
-sub declare_prefix {
- my $self = shift;
- my $prefix = shift;
- my $value = shift;
-
- warn <<' EOWARN' unless defined $prefix or $self->[AUTO_PREFIX];
- Prefix was undefined.
- If you wish to set the default namespace, use the empty string ''.
- If you wish to autogenerate prefixes, set the auto_prefix option
- to a true value.
- EOWARN
-
- no warnings 'uninitialized';
- if ($prefix eq 'xml' and $value ne $NS_XML) {
- die "The xml prefix can only be bound to the $NS_XML namespace."
- }
- elsif ($value eq $NS_XML and $prefix ne 'xml') {
- die "the $NS_XML namespace can only be bound to the xml prefix.";
- }
- elsif ($value eq $NS_XML and $prefix eq 'xml') {
- return 1;
- }
- return 0 if index(lc($prefix), 'xml') == 0;
- use warnings 'uninitialized';
-
- if (defined $prefix and $prefix eq '') {
- $self->[NSMAP]->[-1]->[DEFAULT] = $value;
- }
- else {
- die "Cannot undeclare prefix $prefix" if $value eq '' and not $self->[XMLNS_11];
- if (not defined $prefix and $self->[AUTO_PREFIX]) {
- while (1) {
- $prefix = $self->[UNKNOWN_PREF]++;
- last if not exists $self->[NSMAP]->[-1]->[PREFIX_MAP]->{$prefix};
- }
- }
- elsif (not defined $prefix and not $self->[AUTO_PREFIX]) {
- return 0;
- }
- $self->[NSMAP]->[-1]->[PREFIX_MAP]->{$prefix} = $value;
- }
- push @{$self->[NSMAP]->[-1]->[DECLARATIONS]}, $prefix;
- return 1;
-}
-#-------------------------------------------------------------------#
-
-#-------------------------------------------------------------------#
-# declare_prefixes() - declare several prefixes in the current scope
-#-------------------------------------------------------------------#
-sub declare_prefixes {
- my $self = shift;
- my %prefixes = @_;
- while (my ($k,$v) = each %prefixes) {
- $self->declare_prefix($k,$v);
- }
-}
-#-------------------------------------------------------------------#
-
-#-------------------------------------------------------------------#
-# undeclare_prefix
-#-------------------------------------------------------------------#
-sub undeclare_prefix {
- my $self = shift;
- my $prefix = shift;
- return unless not defined $prefix or $prefix eq '';
- return unless exists $self->[NSMAP]->[-1]->[PREFIX_MAP]->{$prefix};
-
- my ( $tfix ) = grep { $_ eq $prefix } @{$self->[NSMAP]->[-1]->[DECLARATIONS]};
- if ( not defined $tfix ) {
- die "prefix $prefix not declared in this context\n";
- }
-
- @{$self->[NSMAP]->[-1]->[DECLARATIONS]} = grep { $_ ne $prefix } @{$self->[NSMAP]->[-1]->[DECLARATIONS]};
- delete $self->[NSMAP]->[-1]->[PREFIX_MAP]->{$prefix};
-}
-#-------------------------------------------------------------------#
-
-#-------------------------------------------------------------------#
-# get_prefix() - get a (random) prefix for a given URI
-#-------------------------------------------------------------------#
-sub get_prefix {
- my $self = shift;
- my $uri = shift;
-
- # we have to iterate over the whole hash here because if we don't
- # the iterator isn't reset and the next pass will fail
- my $pref;
- while (my ($k, $v) = each %{$self->[NSMAP]->[-1]->[PREFIX_MAP]}) {
- $pref = $k if $v eq $uri;
- }
- return $pref;
-}
-#-------------------------------------------------------------------#
-
-#-------------------------------------------------------------------#
-# get_prefixes() - get all the prefixes for a given URI
-#-------------------------------------------------------------------#
-sub get_prefixes {
- my $self = shift;
- my $uri = shift;
-
- return keys %{$self->[NSMAP]->[-1]->[PREFIX_MAP]} unless defined $uri;
- return grep { $self->[NSMAP]->[-1]->[PREFIX_MAP]->{$_} eq $uri } keys %{$self->[NSMAP]->[-1]->[PREFIX_MAP]};
-}
-#-------------------------------------------------------------------#
-
-#-------------------------------------------------------------------#
-# get_declared_prefixes() - get all prefixes declared in the last context
-#-------------------------------------------------------------------#
-sub get_declared_prefixes {
- return @{$_[0]->[NSMAP]->[-1]->[DECLARATIONS]};
-}
-#-------------------------------------------------------------------#
-
-#-------------------------------------------------------------------#
-# get_uri() - get an URI given a prefix
-#-------------------------------------------------------------------#
-sub get_uri {
- my $self = shift;
- my $prefix = shift;
-
- warn "Prefix must not be undef in get_uri(). The emtpy prefix must be ''" unless defined $prefix;
-
- return $self->[NSMAP]->[-1]->[DEFAULT] if $prefix eq '';
- return $self->[NSMAP]->[-1]->[PREFIX_MAP]->{$prefix} if exists $self->[NSMAP]->[-1]->[PREFIX_MAP]->{$prefix};
- return undef;
-}
-#-------------------------------------------------------------------#
-
-#-------------------------------------------------------------------#
-# process_name() - provide details on a name
-#-------------------------------------------------------------------#
-sub process_name {
- my $self = shift;
- my $qname = shift;
- my $aflag = shift;
-
- if ($self->[FATALS]) {
- return( ($self->_get_ns_details($qname, $aflag))[0,2], $qname );
- }
- else {
- eval { return( ($self->_get_ns_details($qname, $aflag))[0,2], $qname ); }
- }
-}
-#-------------------------------------------------------------------#
-
-#-------------------------------------------------------------------#
-# process_element_name() - provide details on a element's name
-#-------------------------------------------------------------------#
-sub process_element_name {
- my $self = shift;
- my $qname = shift;
-
- if ($self->[FATALS]) {
- return $self->_get_ns_details($qname, 0);
- }
- else {
- eval { return $self->_get_ns_details($qname, 0); }
- }
-}
-#-------------------------------------------------------------------#
-
-
-#-------------------------------------------------------------------#
-# process_attribute_name() - provide details on a attribute's name
-#-------------------------------------------------------------------#
-sub process_attribute_name {
- my $self = shift;
- my $qname = shift;
-
- if ($self->[FATALS]) {
- return $self->_get_ns_details($qname, 1);
- }
- else {
- eval { return $self->_get_ns_details($qname, 1); }
- }
-}
-#-------------------------------------------------------------------#
-
-
-#-------------------------------------------------------------------#
-# ($ns, $prefix, $lname) = $self->_get_ns_details($qname, $f_attr)
-# returns ns, prefix, and lname for a given attribute name
-# >> the $f_attr flag, if set to one, will work for an attribute
-#-------------------------------------------------------------------#
-sub _get_ns_details {
- my $self = shift;
- my $qname = shift;
- my $aflag = shift;
-
- my ($ns, $prefix, $lname);
- (my ($tmp_prefix, $tmp_lname) = split /:/, $qname, 3)
- < 3 or die "Invalid QName: $qname";
-
- # no prefix
- my $cur_map = $self->[NSMAP]->[-1];
- if (not defined($tmp_lname)) {
- $prefix = undef;
- $lname = $qname;
- # attr don't have a default namespace
- $ns = ($aflag) ? undef : $cur_map->[DEFAULT];
- }
-
- # prefix
- else {
- if (exists $cur_map->[PREFIX_MAP]->{$tmp_prefix}) {
- $prefix = $tmp_prefix;
- $lname = $tmp_lname;
- $ns = $cur_map->[PREFIX_MAP]->{$prefix}
- }
- else { # no ns -> lname == name, all rest undef
- die "Undeclared prefix: $tmp_prefix";
- }
- }
-
- return ($ns, $prefix, $lname);
-}
-#-------------------------------------------------------------------#
-
-#-------------------------------------------------------------------#
-# parse_jclark_notation() - parse the Clarkian notation
-#-------------------------------------------------------------------#
-sub parse_jclark_notation {
- shift;
- my $jc = shift;
- $jc =~ m/^\{(.*)\}([^}]+)$/;
- return $1, $2;
-}
-#-------------------------------------------------------------------#
-
-
-#-------------------------------------------------------------------#
-# Java names mapping
-#-------------------------------------------------------------------#
-*XML::NamespaceSupport::pushContext = \&push_context;
-*XML::NamespaceSupport::popContext = \&pop_context;
-*XML::NamespaceSupport::declarePrefix = \&declare_prefix;
-*XML::NamespaceSupport::declarePrefixes = \&declare_prefixes;
-*XML::NamespaceSupport::getPrefix = \&get_prefix;
-*XML::NamespaceSupport::getPrefixes = \&get_prefixes;
-*XML::NamespaceSupport::getDeclaredPrefixes = \&get_declared_prefixes;
-*XML::NamespaceSupport::getURI = \&get_uri;
-*XML::NamespaceSupport::processName = \&process_name;
-*XML::NamespaceSupport::processElementName = \&process_element_name;
-*XML::NamespaceSupport::processAttributeName = \&process_attribute_name;
-*XML::NamespaceSupport::parseJClarkNotation = \&parse_jclark_notation;
-*XML::NamespaceSupport::undeclarePrefix = \&undeclare_prefix;
-#-------------------------------------------------------------------#
-
-
-1;
-#,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,#
-#`,`, Documentation `,`,`,`,`,`,`,`,`,`,`,`,`,`,`,`,`,`,`,`,`,`,`,`,#
-#```````````````````````````````````````````````````````````````````#
-
-=pod
-
-=head1 NAME
-
-XML::NamespaceSupport - a simple generic namespace support class
-
-=head1 SYNOPSIS
-
- use XML::NamespaceSupport;
- my $nsup = XML::NamespaceSupport->new;
-
- # add a new empty context
- $nsup->push_context;
- # declare a few prefixes
- $nsup->declare_prefix($prefix1, $uri1);
- $nsup->declare_prefix($prefix2, $uri2);
- # the same shorter
- $nsup->declare_prefixes($prefix1 => $uri1, $prefix2 => $uri2);
-
- # get a single prefix for a URI (randomly)
- $prefix = $nsup->get_prefix($uri);
- # get all prefixes for a URI (probably better)
- @prefixes = $nsup->get_prefixes($uri);
- # get all prefixes in scope
- @prefixes = $nsup->get_prefixes();
- # get all prefixes that were declared for the current scope
- @prefixes = $nsup->get_declared_prefixes;
- # get a URI for a given prefix
- $uri = $nsup->get_uri($prefix);
-
- # get info on a qname (java-ish way, it's a bit weird)
- ($ns_uri, $local_name, $qname) = $nsup->process_name($qname, $is_attr);
- # the same, more perlish
- ($ns_uri, $prefix, $local_name) = $nsup->process_element_name($qname);
- ($ns_uri, $prefix, $local_name) = $nsup->process_attribute_name($qname);
-
- # remove the current context
- $nsup->pop_context;
-
- # reset the object for reuse in another document
- $nsup->reset;
-
- # a simple helper to process Clarkian Notation
- my ($ns, $lname) = $nsup->parse_jclark_notation('{http://foo}bar');
- # or (given that it doesn't care about the object
- my ($ns, $lname) = XML::NamespaceSupport->parse_jclark_notation('{http://foo}bar');
-
-
-=head1 DESCRIPTION
-
-This module offers a simple to process namespaced XML names (unames)
-from within any application that may need them. It also helps maintain
-a prefix to namespace URI map, and provides a number of basic checks.
-
-The model for this module is SAX2's NamespaceSupport class, readable at
-http://www.megginson.com/SAX/Java/javadoc/org/xml/sax/helpers/NamespaceSupport.html.
-It adds a few perlisations where we thought it appropriate.
-
-=head1 METHODS
-
-=over 4
-
-=item * XML::NamespaceSupport->new(\%options)
-
-A simple constructor.
-
-The options are C<xmlns>, C<fatal_errors>, and C<auto_prefix>
-
-If C<xmlns> is turned on (it is off by default) the mapping from the
-xmlns prefix to the URI defined for it in DOM level 2 is added to the
-list of predefined mappings (which normally only contains the xml
-prefix mapping).
-
-If C<fatal_errors> is turned off (it is on by default) a number of
-validity errors will simply be flagged as failures, instead of
-die()ing.
-
-If C<auto_prefix> is turned on (it is off by default) when one
-provides a prefix of C<undef> to C<declare_prefix> it will generate a
-random prefix mapped to that namespace. Otherwise an undef prefix will
-trigger a warning (you should probably know what you're doing if you
-turn this option on).
-
-If C<xmlns_11> us turned off, it becomes illegal to undeclare namespace
-prefixes. It is on by default. This behaviour is compliant with Namespaces
-in XML 1.1, turning it off reverts you to version 1.0.
-
-=item * $nsup->push_context
-
-Adds a new empty context to the stack. You can then populate it with
-new prefixes defined at this level.
-
-=item * $nsup->pop_context
-
-Removes the topmost context in the stack and reverts to the previous
-one. It will die() if you try to pop more than you have pushed.
-
-=item * $nsup->declare_prefix($prefix, $uri)
-
-Declares a mapping of $prefix to $uri, at the current level.
-
-Note that with C<auto_prefix> turned on, if you declare a prefix
-mapping in which $prefix is undef(), you will get an automatic prefix
-selected for you. If it is off you will get a warning.
-
-This is useful when you deal with code that hasn't kept prefixes around
-and need to reserialize the nodes. It also means that if you want to
-set the default namespace (ie with an empty prefix) you must use the
-empty string instead of undef. This behaviour is consistent with the
-SAX 2.0 specification.
-
-=item * $nsup->declare_prefixes(%prefixes2uris)
-
-Declares a mapping of several prefixes to URIs, at the current level.
-
-=item * $nsup->get_prefix($uri)
-
-Returns a prefix given an URI. Note that as several prefixes may be
-mapped to the same URI, it returns an arbitrary one. It'll return
-undef on failure.
-
-=item * $nsup->get_prefixes($uri)
-
-Returns an array of prefixes given an URI. It'll return all the
-prefixes if the uri is undef.
-
-=item * $nsup->get_declared_prefixes
-
-Returns an array of all the prefixes that have been declared within
-this context, ie those that were declared on the last element, not
-those that were declared above and are simply in scope.
-
-=item * $nsup->get_uri($prefix)
-
-Returns a URI for a given prefix. Returns undef on failure.
-
-=item * $nsup->process_name($qname, $is_attr)
-
-Given a qualified name and a boolean indicating whether this is an
-attribute or another type of name (those are differently affected by
-default namespaces), it returns a namespace URI, local name, qualified
-name tuple. I know that that is a rather abnormal list to return, but
-it is so for compatibility with the Java spec. See below for more
-Perlish alternatives.
-
-If the prefix is not declared, or if the name is not valid, it'll
-either die or return undef depending on the current setting of
-C<fatal_errors>.
-
-=item * $nsup->undeclare_prefix($prefix);
-
-Removes a namespace prefix from the current context. This function may
-be used in SAX's end_prefix_mapping when there is fear that a namespace
-declaration might be available outside their scope (which shouldn't
-normally happen, but you never know ;). This may be needed in order to
-properly support Namespace 1.1.
-
-=item * $nsup->process_element_name($qname)
-
-Given a qualified name, it returns a namespace URI, prefix, and local
-name tuple. This method applies to element names.
-
-If the prefix is not declared, or if the name is not valid, it'll
-either die or return undef depending on the current setting of
-C<fatal_errors>.
-
-=item * $nsup->process_attribute_name($qname)
-
-Given a qualified name, it returns a namespace URI, prefix, and local
-name tuple. This method applies to attribute names.
-
-If the prefix is not declared, or if the name is not valid, it'll
-either die or return undef depending on the current setting of
-C<fatal_errors>.
-
-=item * $nsup->reset
-
-Resets the object so that it can be reused on another document.
-
-=back
-
-All methods of the interface have an alias that is the name used in
-the original Java specification. You can use either name
-interchangeably. Here is the mapping:
-
- Java name Perl name
- ---------------------------------------------------
- pushContext push_context
- popContext pop_context
- declarePrefix declare_prefix
- declarePrefixes declare_prefixes
- getPrefix get_prefix
- getPrefixes get_prefixes
- getDeclaredPrefixes get_declared_prefixes
- getURI get_uri
- processName process_name
- processElementName process_element_name
- processAttributeName process_attribute_name
- parseJClarkNotation parse_jclark_notation
- undeclarePrefix undeclare_prefix
-
-=head1 VARIABLES
-
-Two global variables are made available to you. They used to be constants but
-simple scalars are easier to use in a number of contexts. They are not
-exported but can easily be accessed from any package, or copied into it.
-
-=over 4
-
-=item * C<$NS_XMLNS>
-
-The namespace for xmlns prefixes, http://www.w3.org/2000/xmlns/.
-
-=item * C<$NS_XML>
-
-The namespace for xml prefixes, http://www.w3.org/XML/1998/namespace.
-
-=back
-
-=head1 TODO
-
- - add more tests
- - optimise here and there
-
-=head1 AUTHOR
-
-Robin Berjon, robin@knowscape.com, with lots of it having been done
-by Duncan Cameron, and a number of suggestions from the perl-xml
-list.
-
-=head1 COPYRIGHT
-
-Copyright (c) 2001-2005 Robin Berjon. 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
-
-XML::Parser::PerlSAX
-
-=cut
-
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/XML/SAX.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/XML/SAX.pm
deleted file mode 100644
index 46714da1476..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/XML/SAX.pm
+++ /dev/null
@@ -1,379 +0,0 @@
-# $Id: SAX.pm,v 1.29 2007/06/27 09:09:12 grant Exp $
-
-package XML::SAX;
-
-use strict;
-use vars qw($VERSION @ISA @EXPORT_OK);
-
-$VERSION = '0.16';
-
-use Exporter ();
-@ISA = ('Exporter');
-
-@EXPORT_OK = qw(Namespaces Validation);
-
-use File::Basename qw(dirname);
-use File::Spec ();
-use Symbol qw(gensym);
-use XML::SAX::ParserFactory (); # loaded for simplicity
-
-use constant PARSER_DETAILS => "ParserDetails.ini";
-
-use constant Namespaces => "http://xml.org/sax/features/namespaces";
-use constant Validation => "http://xml.org/sax/features/validation";
-
-my $known_parsers = undef;
-
-# load_parsers takes the ParserDetails.ini file out of the same directory
-# that XML::SAX is in, and looks at it. Format in POD below
-
-=begin EXAMPLE
-
-[XML::SAX::PurePerl]
-http://xml.org/sax/features/namespaces = 1
-http://xml.org/sax/features/validation = 0
-# a comment
-
-# blank lines ignored
-
-[XML::SAX::AnotherParser]
-http://xml.org/sax/features/namespaces = 0
-http://xml.org/sax/features/validation = 1
-
-=end EXAMPLE
-
-=cut
-
-sub load_parsers {
- my $class = shift;
- my $dir = shift;
-
- # reset parsers
- $known_parsers = [];
-
- # get directory from wherever XML::SAX is installed
- if (!$dir) {
- $dir = $INC{'XML/SAX.pm'};
- $dir = dirname($dir);
- }
-
- my $fh = gensym();
- if (!open($fh, File::Spec->catfile($dir, "SAX", PARSER_DETAILS))) {
- XML::SAX->do_warn("could not find " . PARSER_DETAILS . " in $dir/SAX\n");
- return $class;
- }
-
- $known_parsers = $class->_parse_ini_file($fh);
-
- return $class;
-}
-
-sub _parse_ini_file {
- my $class = shift;
- my ($fh) = @_;
-
- my @config;
-
- my $lineno = 0;
- while (defined(my $line = <$fh>)) {
- $lineno++;
- my $original = $line;
- # strip whitespace
- $line =~ s/\s*$//m;
- $line =~ s/^\s*//m;
- # strip comments
- $line =~ s/[#;].*$//m;
- # ignore blanks
- next if $line =~ /^$/m;
-
- # heading
- if ($line =~ /^\[\s*(.*)\s*\]$/m) {
- push @config, { Name => $1 };
- next;
- }
-
- # instruction
- elsif ($line =~ /^(.*?)\s*?=\s*(.*)$/) {
- unless(@config) {
- push @config, { Name => '' };
- }
- $config[-1]{Features}{$1} = $2;
- }
-
- # not whitespace, comment, or instruction
- else {
- die "Invalid line in ini: $lineno\n>>> $original\n";
- }
- }
-
- return \@config;
-}
-
-sub parsers {
- my $class = shift;
- if (!$known_parsers) {
- $class->load_parsers();
- }
- return $known_parsers;
-}
-
-sub remove_parser {
- my $class = shift;
- my ($parser_module) = @_;
-
- if (!$known_parsers) {
- $class->load_parsers();
- }
-
- @$known_parsers = grep { $_->{Name} ne $parser_module } @$known_parsers;
-
- return $class;
-}
-
-sub add_parser {
- my $class = shift;
- my ($parser_module) = @_;
-
- if (!$known_parsers) {
- $class->load_parsers();
- }
-
- # first load module, then query features, then push onto known_parsers,
-
- my $parser_file = $parser_module;
- $parser_file =~ s/::/\//g;
- $parser_file .= ".pm";
-
- require $parser_file;
-
- my @features = $parser_module->supported_features();
-
- my $new = { Name => $parser_module };
- foreach my $feature (@features) {
- $new->{Features}{$feature} = 1;
- }
-
- # If exists in list already, move to end.
- my $done = 0;
- my $pos = undef;
- for (my $i = 0; $i < @$known_parsers; $i++) {
- my $p = $known_parsers->[$i];
- if ($p->{Name} eq $parser_module) {
- $pos = $i;
- }
- }
- if (defined $pos) {
- splice(@$known_parsers, $pos, 1);
- push @$known_parsers, $new;
- $done++;
- }
-
- # Otherwise (not in list), add at end of list.
- if (!$done) {
- push @$known_parsers, $new;
- }
-
- return $class;
-}
-
-sub save_parsers {
- my $class = shift;
-
- # get directory from wherever XML::SAX is installed
- my $dir = $INC{'XML/SAX.pm'};
- $dir = dirname($dir);
-
- my $file = File::Spec->catfile($dir, "SAX", PARSER_DETAILS);
- chmod 0644, $file;
- unlink($file);
-
- my $fh = gensym();
- open($fh, ">$file") ||
- die "Cannot write to $file: $!";
-
- foreach my $p (@$known_parsers) {
- print $fh "[$p->{Name}]\n";
- foreach my $key (keys %{$p->{Features}}) {
- print $fh "$key = $p->{Features}{$key}\n";
- }
- print $fh "\n";
- }
-
- print $fh "\n";
-
- close $fh;
-
- return $class;
-}
-
-sub do_warn {
- my $class = shift;
- # Don't output warnings if running under Test::Harness
- warn(@_) unless $ENV{HARNESS_ACTIVE};
-}
-
-1;
-__END__
-
-=head1 NAME
-
-XML::SAX - Simple API for XML
-
-=head1 SYNOPSIS
-
- use XML::SAX;
-
- # get a list of known parsers
- my $parsers = XML::SAX->parsers();
-
- # add/update a parser
- XML::SAX->add_parser(q(XML::SAX::PurePerl));
-
- # remove parser
- XML::SAX->remove_parser(q(XML::SAX::Foodelberry));
-
- # save parsers
- XML::SAX->save_parsers();
-
-=head1 DESCRIPTION
-
-XML::SAX is a SAX parser access API for Perl. It includes classes
-and APIs required for implementing SAX drivers, along with a factory
-class for returning any SAX parser installed on the user's system.
-
-=head1 USING A SAX2 PARSER
-
-The factory class is XML::SAX::ParserFactory. Please see the
-documentation of that module for how to instantiate a SAX parser:
-L<XML::SAX::ParserFactory>. However if you don't want to load up
-another manual page, here's a short synopsis:
-
- use XML::SAX::ParserFactory;
- use XML::SAX::XYZHandler;
- my $handler = XML::SAX::XYZHandler->new();
- my $p = XML::SAX::ParserFactory->parser(Handler => $handler);
- $p->parse_uri("foo.xml");
- # or $p->parse_string("<foo/>") or $p->parse_file($fh);
-
-This will automatically load a SAX2 parser (defaulting to
-XML::SAX::PurePerl if no others are found) and return it to you.
-
-In order to learn how to use SAX to parse XML, you will need to read
-L<XML::SAX::Intro> and for reference, L<XML::SAX::Specification>.
-
-=head1 WRITING A SAX2 PARSER
-
-The first thing to remember in writing a SAX2 parser is to subclass
-XML::SAX::Base. This will make your life infinitely easier, by providing
-a number of methods automagically for you. See L<XML::SAX::Base> for more
-details.
-
-When writing a SAX2 parser that is compatible with XML::SAX, you need
-to inform XML::SAX of the presence of that driver when you install it.
-In order to do that, XML::SAX contains methods for saving the fact that
-the parser exists on your system to a "INI" file, which is then loaded
-to determine which parsers are installed.
-
-The best way to do this is to follow these rules:
-
-=over 4
-
-=item * Add XML::SAX as a prerequisite in Makefile.PL:
-
- WriteMakefile(
- ...
- PREREQ_PM => { 'XML::SAX' => 0 },
- ...
- );
-
-Alternatively you may wish to check for it in other ways that will
-cause more than just a warning.
-
-=item * Add the following code snippet to your Makefile.PL:
-
- sub MY::install {
- package MY;
- my $script = shift->SUPER::install(@_);
- if (ExtUtils::MakeMaker::prompt(
- "Do you want to modify ParserDetails.ini?", 'Y')
- =~ /^y/i) {
- $script =~ s/install :: (.*)$/install :: $1 install_sax_driver/m;
- $script .= <<"INSTALL";
-
- install_sax_driver :
- \t\@\$(PERL) -MXML::SAX -e "XML::SAX->add_parser(q(\$(NAME)))->save_parsers()"
-
- INSTALL
- }
- return $script;
- }
-
-Note that you should check the output of this - \$(NAME) will use the name of
-your distribution, which may not be exactly what you want. For example XML::LibXML
-has a driver called XML::LibXML::SAX::Generator, which is used in place of
-\$(NAME) in the above.
-
-=item * Add an XML::SAX test:
-
-A test file should be added to your t/ directory containing something like the
-following:
-
- use Test;
- BEGIN { plan tests => 3 }
- use XML::SAX;
- use XML::SAX::PurePerl::DebugHandler;
- XML::SAX->add_parser(q(XML::SAX::MyDriver));
- local $XML::SAX::ParserPackage = 'XML::SAX::MyDriver';
- eval {
- my $handler = XML::SAX::PurePerl::DebugHandler->new();
- ok($handler);
- my $parser = XML::SAX::ParserFactory->parser(Handler => $handler);
- ok($parser);
- ok($parser->isa('XML::SAX::MyDriver');
- $parser->parse_string("<tag/>");
- ok($handler->{seen}{start_element});
- };
-
-=back
-
-=head1 EXPORTS
-
-By default, XML::SAX exports nothing into the caller's namespace. However you
-can request the symbols C<Namespaces> and C<Validation> which are the
-URIs for those features, allowing an easier way to request those features
-via ParserFactory:
-
- use XML::SAX qw(Namespaces Validation);
- my $factory = XML::SAX::ParserFactory->new();
- $factory->require_feature(Namespaces);
- $factory->require_feature(Validation);
- my $parser = $factory->parser();
-
-=head1 AUTHOR
-
-Current maintainer: Grant McLean, grantm@cpan.org
-
-Originally written by:
-
-Matt Sergeant, matt@sergeant.org
-
-Kip Hampton, khampton@totalcinema.com
-
-Robin Berjon, robin@knowscape.com
-
-=head1 LICENSE
-
-This is free software, you may use it and distribute it under
-the same terms as Perl itself.
-
-=head1 SEE ALSO
-
-L<XML::SAX::Base> for writing SAX Filters and Parsers
-
-L<XML::SAX::PurePerl> for an XML parser written in 100%
-pure perl.
-
-L<XML::SAX::Exception> for details on exception handling
-
-=cut
-
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/XML/SAX/Base.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/XML/SAX/Base.pm
deleted file mode 100644
index 5de3f5ce783..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/XML/SAX/Base.pm
+++ /dev/null
@@ -1,3164 +0,0 @@
-package XML::SAX::Base;
-
-# version 0.10 - Kip Hampton <khampton@totalcinema.com>
-# version 0.13 - Robin Berjon <robin@knowscape.com>
-# version 0.15 - Kip Hampton <khampton@totalcinema.com>
-# version 0.17 - Kip Hampton <khampton@totalcinema.com>
-# version 0.19 - Kip Hampton <khampton@totalcinema.com>
-# version 0.21 - Kip Hampton <khampton@totalcinema.com>
-# version 0.22 - Robin Berjon <robin@knowscape.com>
-# version 0.23 - Matt Sergeant <matt@sergeant.org>
-# version 0.24 - Robin Berjon <robin@knowscape.com>
-# version 0.25 - Kip Hampton <khampton@totalcinema.com>
-# version 1.00 - Kip Hampton <khampton@totalcinema.com>
-# version 1.01 - Kip Hampton <khampton@totalcinema.com>
-# version 1.02 - Robin Berjon <robin@knowscape.com>
-# version 1.03 - Matt Sergeant <matt@sergeant.org>
-# version 1.04 - Kip Hampton <khampton@totalcinema.com>
-
-#-----------------------------------------------------#
-# STOP!!!!!
-#
-# This file is generated by the 'Makefile.PL' file
-# that ships with the XML::SAX distribution.
-# If you need to make changes, patch that file NOT
-# this one.
-#-----------------------------------------------------#
-
-use strict;
-use vars qw($VERSION);
-use XML::SAX::Exception qw();
-
-$VERSION = '1.04';
-
-sub end_prefix_mapping {
- my $self = shift;
- if (defined $self->{Methods}->{'end_prefix_mapping'}) {
- $self->{Methods}->{'end_prefix_mapping'}->(@_);
- }
- else {
- my $method;
- my $callbacks;
- if (exists $self->{ParseOptions}) {
- $callbacks = $self->{ParseOptions};
- }
- else {
- $callbacks = $self;
- }
- if (0) { # dummy to make elsif's below compile
- }
- elsif (defined $callbacks->{'ContentHandler'} and $method = $callbacks->{'ContentHandler'}->can('end_prefix_mapping') ) {
- my $handler = $callbacks->{'ContentHandler'};
- $self->{Methods}->{'end_prefix_mapping'} = sub { $method->($handler, @_) };
- return $method->($handler, @_);
- }
- elsif (defined $callbacks->{'Handler'} and $method = $callbacks->{'Handler'}->can('end_prefix_mapping') ) {
- my $handler = $callbacks->{'Handler'};
- $self->{Methods}->{'end_prefix_mapping'} = sub { $method->($handler, @_) };
- return $method->($handler, @_);
- }
- elsif (defined $callbacks->{'ContentHandler'}
- and $callbacks->{'ContentHandler'}->can('AUTOLOAD')
- and $callbacks->{'ContentHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '')
- )
- {
- my $res = eval { $callbacks->{'ContentHandler'}->end_prefix_mapping(@_) };
- if ($@) {
- die $@;
- }
- else {
- # I think there's a buggette here...
- # if the first call throws an exception, we don't set it up right.
- # Not fatal, but we might want to address it.
- my $handler = $callbacks->{'ContentHandler'};
- $self->{Methods}->{'end_prefix_mapping'} = sub { $handler->end_prefix_mapping(@_) };
- }
- return $res;
- }
- elsif (defined $callbacks->{'Handler'}
- and $callbacks->{'Handler'}->can('AUTOLOAD')
- and $callbacks->{'Handler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '')
- )
- {
- my $res = eval { $callbacks->{'Handler'}->end_prefix_mapping(@_) };
- if ($@) {
- die $@;
- }
- else {
- # I think there's a buggette here...
- # if the first call throws an exception, we don't set it up right.
- # Not fatal, but we might want to address it.
- my $handler = $callbacks->{'Handler'};
- $self->{Methods}->{'end_prefix_mapping'} = sub { $handler->end_prefix_mapping(@_) };
- }
- return $res;
- }
- else {
- $self->{Methods}->{'end_prefix_mapping'} = sub { };
- }
- }
-
-}
-
-sub internal_entity_decl {
- my $self = shift;
- if (defined $self->{Methods}->{'internal_entity_decl'}) {
- $self->{Methods}->{'internal_entity_decl'}->(@_);
- }
- else {
- my $method;
- my $callbacks;
- if (exists $self->{ParseOptions}) {
- $callbacks = $self->{ParseOptions};
- }
- else {
- $callbacks = $self;
- }
- if (0) { # dummy to make elsif's below compile
- }
- elsif (defined $callbacks->{'DeclHandler'} and $method = $callbacks->{'DeclHandler'}->can('internal_entity_decl') ) {
- my $handler = $callbacks->{'DeclHandler'};
- $self->{Methods}->{'internal_entity_decl'} = sub { $method->($handler, @_) };
- return $method->($handler, @_);
- }
- elsif (defined $callbacks->{'Handler'} and $method = $callbacks->{'Handler'}->can('internal_entity_decl') ) {
- my $handler = $callbacks->{'Handler'};
- $self->{Methods}->{'internal_entity_decl'} = sub { $method->($handler, @_) };
- return $method->($handler, @_);
- }
- elsif (defined $callbacks->{'DeclHandler'}
- and $callbacks->{'DeclHandler'}->can('AUTOLOAD')
- and $callbacks->{'DeclHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '')
- )
- {
- my $res = eval { $callbacks->{'DeclHandler'}->internal_entity_decl(@_) };
- if ($@) {
- die $@;
- }
- else {
- # I think there's a buggette here...
- # if the first call throws an exception, we don't set it up right.
- # Not fatal, but we might want to address it.
- my $handler = $callbacks->{'DeclHandler'};
- $self->{Methods}->{'internal_entity_decl'} = sub { $handler->internal_entity_decl(@_) };
- }
- return $res;
- }
- elsif (defined $callbacks->{'Handler'}
- and $callbacks->{'Handler'}->can('AUTOLOAD')
- and $callbacks->{'Handler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '')
- )
- {
- my $res = eval { $callbacks->{'Handler'}->internal_entity_decl(@_) };
- if ($@) {
- die $@;
- }
- else {
- # I think there's a buggette here...
- # if the first call throws an exception, we don't set it up right.
- # Not fatal, but we might want to address it.
- my $handler = $callbacks->{'Handler'};
- $self->{Methods}->{'internal_entity_decl'} = sub { $handler->internal_entity_decl(@_) };
- }
- return $res;
- }
- else {
- $self->{Methods}->{'internal_entity_decl'} = sub { };
- }
- }
-
-}
-
-sub characters {
- my $self = shift;
- if (defined $self->{Methods}->{'characters'}) {
- $self->{Methods}->{'characters'}->(@_);
- }
- else {
- my $method;
- my $callbacks;
- if (exists $self->{ParseOptions}) {
- $callbacks = $self->{ParseOptions};
- }
- else {
- $callbacks = $self;
- }
- if (0) { # dummy to make elsif's below compile
- }
- elsif (defined $callbacks->{'ContentHandler'} and $method = $callbacks->{'ContentHandler'}->can('characters') ) {
- my $handler = $callbacks->{'ContentHandler'};
- $self->{Methods}->{'characters'} = sub { $method->($handler, @_) };
- return $method->($handler, @_);
- }
- elsif (defined $callbacks->{'DocumentHandler'} and $method = $callbacks->{'DocumentHandler'}->can('characters') ) {
- my $handler = $callbacks->{'DocumentHandler'};
- $self->{Methods}->{'characters'} = sub { $method->($handler, @_) };
- return $method->($handler, @_);
- }
- elsif (defined $callbacks->{'Handler'} and $method = $callbacks->{'Handler'}->can('characters') ) {
- my $handler = $callbacks->{'Handler'};
- $self->{Methods}->{'characters'} = sub { $method->($handler, @_) };
- return $method->($handler, @_);
- }
- elsif (defined $callbacks->{'ContentHandler'}
- and $callbacks->{'ContentHandler'}->can('AUTOLOAD')
- and $callbacks->{'ContentHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '')
- )
- {
- my $res = eval { $callbacks->{'ContentHandler'}->characters(@_) };
- if ($@) {
- die $@;
- }
- else {
- # I think there's a buggette here...
- # if the first call throws an exception, we don't set it up right.
- # Not fatal, but we might want to address it.
- my $handler = $callbacks->{'ContentHandler'};
- $self->{Methods}->{'characters'} = sub { $handler->characters(@_) };
- }
- return $res;
- }
- elsif (defined $callbacks->{'DocumentHandler'}
- and $callbacks->{'DocumentHandler'}->can('AUTOLOAD')
- and $callbacks->{'DocumentHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '')
- )
- {
- my $res = eval { $callbacks->{'DocumentHandler'}->characters(@_) };
- if ($@) {
- die $@;
- }
- else {
- # I think there's a buggette here...
- # if the first call throws an exception, we don't set it up right.
- # Not fatal, but we might want to address it.
- my $handler = $callbacks->{'DocumentHandler'};
- $self->{Methods}->{'characters'} = sub { $handler->characters(@_) };
- }
- return $res;
- }
- elsif (defined $callbacks->{'Handler'}
- and $callbacks->{'Handler'}->can('AUTOLOAD')
- and $callbacks->{'Handler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '')
- )
- {
- my $res = eval { $callbacks->{'Handler'}->characters(@_) };
- if ($@) {
- die $@;
- }
- else {
- # I think there's a buggette here...
- # if the first call throws an exception, we don't set it up right.
- # Not fatal, but we might want to address it.
- my $handler = $callbacks->{'Handler'};
- $self->{Methods}->{'characters'} = sub { $handler->characters(@_) };
- }
- return $res;
- }
- else {
- $self->{Methods}->{'characters'} = sub { };
- }
- }
-
-}
-
-sub start_element {
- my $self = shift;
- if (defined $self->{Methods}->{'start_element'}) {
- $self->{Methods}->{'start_element'}->(@_);
- }
- else {
- my $method;
- my $callbacks;
- if (exists $self->{ParseOptions}) {
- $callbacks = $self->{ParseOptions};
- }
- else {
- $callbacks = $self;
- }
- if (0) { # dummy to make elsif's below compile
- }
- elsif (defined $callbacks->{'ContentHandler'} and $method = $callbacks->{'ContentHandler'}->can('start_element') ) {
- my $handler = $callbacks->{'ContentHandler'};
- $self->{Methods}->{'start_element'} = sub { $method->($handler, @_) };
- return $method->($handler, @_);
- }
- elsif (defined $callbacks->{'DocumentHandler'} and $method = $callbacks->{'DocumentHandler'}->can('start_element') ) {
- my $handler = $callbacks->{'DocumentHandler'};
- $self->{Methods}->{'start_element'} = sub { $method->($handler, @_) };
- return $method->($handler, @_);
- }
- elsif (defined $callbacks->{'Handler'} and $method = $callbacks->{'Handler'}->can('start_element') ) {
- my $handler = $callbacks->{'Handler'};
- $self->{Methods}->{'start_element'} = sub { $method->($handler, @_) };
- return $method->($handler, @_);
- }
- elsif (defined $callbacks->{'ContentHandler'}
- and $callbacks->{'ContentHandler'}->can('AUTOLOAD')
- and $callbacks->{'ContentHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '')
- )
- {
- my $res = eval { $callbacks->{'ContentHandler'}->start_element(@_) };
- if ($@) {
- die $@;
- }
- else {
- # I think there's a buggette here...
- # if the first call throws an exception, we don't set it up right.
- # Not fatal, but we might want to address it.
- my $handler = $callbacks->{'ContentHandler'};
- $self->{Methods}->{'start_element'} = sub { $handler->start_element(@_) };
- }
- return $res;
- }
- elsif (defined $callbacks->{'DocumentHandler'}
- and $callbacks->{'DocumentHandler'}->can('AUTOLOAD')
- and $callbacks->{'DocumentHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '')
- )
- {
- my $res = eval { $callbacks->{'DocumentHandler'}->start_element(@_) };
- if ($@) {
- die $@;
- }
- else {
- # I think there's a buggette here...
- # if the first call throws an exception, we don't set it up right.
- # Not fatal, but we might want to address it.
- my $handler = $callbacks->{'DocumentHandler'};
- $self->{Methods}->{'start_element'} = sub { $handler->start_element(@_) };
- }
- return $res;
- }
- elsif (defined $callbacks->{'Handler'}
- and $callbacks->{'Handler'}->can('AUTOLOAD')
- and $callbacks->{'Handler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '')
- )
- {
- my $res = eval { $callbacks->{'Handler'}->start_element(@_) };
- if ($@) {
- die $@;
- }
- else {
- # I think there's a buggette here...
- # if the first call throws an exception, we don't set it up right.
- # Not fatal, but we might want to address it.
- my $handler = $callbacks->{'Handler'};
- $self->{Methods}->{'start_element'} = sub { $handler->start_element(@_) };
- }
- return $res;
- }
- else {
- $self->{Methods}->{'start_element'} = sub { };
- }
- }
-
-}
-
-sub external_entity_decl {
- my $self = shift;
- if (defined $self->{Methods}->{'external_entity_decl'}) {
- $self->{Methods}->{'external_entity_decl'}->(@_);
- }
- else {
- my $method;
- my $callbacks;
- if (exists $self->{ParseOptions}) {
- $callbacks = $self->{ParseOptions};
- }
- else {
- $callbacks = $self;
- }
- if (0) { # dummy to make elsif's below compile
- }
- elsif (defined $callbacks->{'DeclHandler'} and $method = $callbacks->{'DeclHandler'}->can('external_entity_decl') ) {
- my $handler = $callbacks->{'DeclHandler'};
- $self->{Methods}->{'external_entity_decl'} = sub { $method->($handler, @_) };
- return $method->($handler, @_);
- }
- elsif (defined $callbacks->{'Handler'} and $method = $callbacks->{'Handler'}->can('external_entity_decl') ) {
- my $handler = $callbacks->{'Handler'};
- $self->{Methods}->{'external_entity_decl'} = sub { $method->($handler, @_) };
- return $method->($handler, @_);
- }
- elsif (defined $callbacks->{'DeclHandler'}
- and $callbacks->{'DeclHandler'}->can('AUTOLOAD')
- and $callbacks->{'DeclHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '')
- )
- {
- my $res = eval { $callbacks->{'DeclHandler'}->external_entity_decl(@_) };
- if ($@) {
- die $@;
- }
- else {
- # I think there's a buggette here...
- # if the first call throws an exception, we don't set it up right.
- # Not fatal, but we might want to address it.
- my $handler = $callbacks->{'DeclHandler'};
- $self->{Methods}->{'external_entity_decl'} = sub { $handler->external_entity_decl(@_) };
- }
- return $res;
- }
- elsif (defined $callbacks->{'Handler'}
- and $callbacks->{'Handler'}->can('AUTOLOAD')
- and $callbacks->{'Handler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '')
- )
- {
- my $res = eval { $callbacks->{'Handler'}->external_entity_decl(@_) };
- if ($@) {
- die $@;
- }
- else {
- # I think there's a buggette here...
- # if the first call throws an exception, we don't set it up right.
- # Not fatal, but we might want to address it.
- my $handler = $callbacks->{'Handler'};
- $self->{Methods}->{'external_entity_decl'} = sub { $handler->external_entity_decl(@_) };
- }
- return $res;
- }
- else {
- $self->{Methods}->{'external_entity_decl'} = sub { };
- }
- }
-
-}
-
-sub xml_decl {
- my $self = shift;
- if (defined $self->{Methods}->{'xml_decl'}) {
- $self->{Methods}->{'xml_decl'}->(@_);
- }
- else {
- my $method;
- my $callbacks;
- if (exists $self->{ParseOptions}) {
- $callbacks = $self->{ParseOptions};
- }
- else {
- $callbacks = $self;
- }
- if (0) { # dummy to make elsif's below compile
- }
- elsif (defined $callbacks->{'DTDHandler'} and $method = $callbacks->{'DTDHandler'}->can('xml_decl') ) {
- my $handler = $callbacks->{'DTDHandler'};
- $self->{Methods}->{'xml_decl'} = sub { $method->($handler, @_) };
- return $method->($handler, @_);
- }
- elsif (defined $callbacks->{'Handler'} and $method = $callbacks->{'Handler'}->can('xml_decl') ) {
- my $handler = $callbacks->{'Handler'};
- $self->{Methods}->{'xml_decl'} = sub { $method->($handler, @_) };
- return $method->($handler, @_);
- }
- elsif (defined $callbacks->{'DTDHandler'}
- and $callbacks->{'DTDHandler'}->can('AUTOLOAD')
- and $callbacks->{'DTDHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '')
- )
- {
- my $res = eval { $callbacks->{'DTDHandler'}->xml_decl(@_) };
- if ($@) {
- die $@;
- }
- else {
- # I think there's a buggette here...
- # if the first call throws an exception, we don't set it up right.
- # Not fatal, but we might want to address it.
- my $handler = $callbacks->{'DTDHandler'};
- $self->{Methods}->{'xml_decl'} = sub { $handler->xml_decl(@_) };
- }
- return $res;
- }
- elsif (defined $callbacks->{'Handler'}
- and $callbacks->{'Handler'}->can('AUTOLOAD')
- and $callbacks->{'Handler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '')
- )
- {
- my $res = eval { $callbacks->{'Handler'}->xml_decl(@_) };
- if ($@) {
- die $@;
- }
- else {
- # I think there's a buggette here...
- # if the first call throws an exception, we don't set it up right.
- # Not fatal, but we might want to address it.
- my $handler = $callbacks->{'Handler'};
- $self->{Methods}->{'xml_decl'} = sub { $handler->xml_decl(@_) };
- }
- return $res;
- }
- else {
- $self->{Methods}->{'xml_decl'} = sub { };
- }
- }
-
-}
-
-sub entity_decl {
- my $self = shift;
- if (defined $self->{Methods}->{'entity_decl'}) {
- $self->{Methods}->{'entity_decl'}->(@_);
- }
- else {
- my $method;
- my $callbacks;
- if (exists $self->{ParseOptions}) {
- $callbacks = $self->{ParseOptions};
- }
- else {
- $callbacks = $self;
- }
- if (0) { # dummy to make elsif's below compile
- }
- elsif (defined $callbacks->{'DTDHandler'} and $method = $callbacks->{'DTDHandler'}->can('entity_decl') ) {
- my $handler = $callbacks->{'DTDHandler'};
- $self->{Methods}->{'entity_decl'} = sub { $method->($handler, @_) };
- return $method->($handler, @_);
- }
- elsif (defined $callbacks->{'Handler'} and $method = $callbacks->{'Handler'}->can('entity_decl') ) {
- my $handler = $callbacks->{'Handler'};
- $self->{Methods}->{'entity_decl'} = sub { $method->($handler, @_) };
- return $method->($handler, @_);
- }
- elsif (defined $callbacks->{'DTDHandler'}
- and $callbacks->{'DTDHandler'}->can('AUTOLOAD')
- and $callbacks->{'DTDHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '')
- )
- {
- my $res = eval { $callbacks->{'DTDHandler'}->entity_decl(@_) };
- if ($@) {
- die $@;
- }
- else {
- # I think there's a buggette here...
- # if the first call throws an exception, we don't set it up right.
- # Not fatal, but we might want to address it.
- my $handler = $callbacks->{'DTDHandler'};
- $self->{Methods}->{'entity_decl'} = sub { $handler->entity_decl(@_) };
- }
- return $res;
- }
- elsif (defined $callbacks->{'Handler'}
- and $callbacks->{'Handler'}->can('AUTOLOAD')
- and $callbacks->{'Handler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '')
- )
- {
- my $res = eval { $callbacks->{'Handler'}->entity_decl(@_) };
- if ($@) {
- die $@;
- }
- else {
- # I think there's a buggette here...
- # if the first call throws an exception, we don't set it up right.
- # Not fatal, but we might want to address it.
- my $handler = $callbacks->{'Handler'};
- $self->{Methods}->{'entity_decl'} = sub { $handler->entity_decl(@_) };
- }
- return $res;
- }
- else {
- $self->{Methods}->{'entity_decl'} = sub { };
- }
- }
-
-}
-
-sub end_dtd {
- my $self = shift;
- if (defined $self->{Methods}->{'end_dtd'}) {
- $self->{Methods}->{'end_dtd'}->(@_);
- }
- else {
- my $method;
- my $callbacks;
- if (exists $self->{ParseOptions}) {
- $callbacks = $self->{ParseOptions};
- }
- else {
- $callbacks = $self;
- }
- if (0) { # dummy to make elsif's below compile
- }
- elsif (defined $callbacks->{'LexicalHandler'} and $method = $callbacks->{'LexicalHandler'}->can('end_dtd') ) {
- my $handler = $callbacks->{'LexicalHandler'};
- $self->{Methods}->{'end_dtd'} = sub { $method->($handler, @_) };
- return $method->($handler, @_);
- }
- elsif (defined $callbacks->{'Handler'} and $method = $callbacks->{'Handler'}->can('end_dtd') ) {
- my $handler = $callbacks->{'Handler'};
- $self->{Methods}->{'end_dtd'} = sub { $method->($handler, @_) };
- return $method->($handler, @_);
- }
- elsif (defined $callbacks->{'LexicalHandler'}
- and $callbacks->{'LexicalHandler'}->can('AUTOLOAD')
- and $callbacks->{'LexicalHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '')
- )
- {
- my $res = eval { $callbacks->{'LexicalHandler'}->end_dtd(@_) };
- if ($@) {
- die $@;
- }
- else {
- # I think there's a buggette here...
- # if the first call throws an exception, we don't set it up right.
- # Not fatal, but we might want to address it.
- my $handler = $callbacks->{'LexicalHandler'};
- $self->{Methods}->{'end_dtd'} = sub { $handler->end_dtd(@_) };
- }
- return $res;
- }
- elsif (defined $callbacks->{'Handler'}
- and $callbacks->{'Handler'}->can('AUTOLOAD')
- and $callbacks->{'Handler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '')
- )
- {
- my $res = eval { $callbacks->{'Handler'}->end_dtd(@_) };
- if ($@) {
- die $@;
- }
- else {
- # I think there's a buggette here...
- # if the first call throws an exception, we don't set it up right.
- # Not fatal, but we might want to address it.
- my $handler = $callbacks->{'Handler'};
- $self->{Methods}->{'end_dtd'} = sub { $handler->end_dtd(@_) };
- }
- return $res;
- }
- else {
- $self->{Methods}->{'end_dtd'} = sub { };
- }
- }
-
-}
-
-sub unparsed_entity_decl {
- my $self = shift;
- if (defined $self->{Methods}->{'unparsed_entity_decl'}) {
- $self->{Methods}->{'unparsed_entity_decl'}->(@_);
- }
- else {
- my $method;
- my $callbacks;
- if (exists $self->{ParseOptions}) {
- $callbacks = $self->{ParseOptions};
- }
- else {
- $callbacks = $self;
- }
- if (0) { # dummy to make elsif's below compile
- }
- elsif (defined $callbacks->{'DTDHandler'} and $method = $callbacks->{'DTDHandler'}->can('unparsed_entity_decl') ) {
- my $handler = $callbacks->{'DTDHandler'};
- $self->{Methods}->{'unparsed_entity_decl'} = sub { $method->($handler, @_) };
- return $method->($handler, @_);
- }
- elsif (defined $callbacks->{'Handler'} and $method = $callbacks->{'Handler'}->can('unparsed_entity_decl') ) {
- my $handler = $callbacks->{'Handler'};
- $self->{Methods}->{'unparsed_entity_decl'} = sub { $method->($handler, @_) };
- return $method->($handler, @_);
- }
- elsif (defined $callbacks->{'DTDHandler'}
- and $callbacks->{'DTDHandler'}->can('AUTOLOAD')
- and $callbacks->{'DTDHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '')
- )
- {
- my $res = eval { $callbacks->{'DTDHandler'}->unparsed_entity_decl(@_) };
- if ($@) {
- die $@;
- }
- else {
- # I think there's a buggette here...
- # if the first call throws an exception, we don't set it up right.
- # Not fatal, but we might want to address it.
- my $handler = $callbacks->{'DTDHandler'};
- $self->{Methods}->{'unparsed_entity_decl'} = sub { $handler->unparsed_entity_decl(@_) };
- }
- return $res;
- }
- elsif (defined $callbacks->{'Handler'}
- and $callbacks->{'Handler'}->can('AUTOLOAD')
- and $callbacks->{'Handler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '')
- )
- {
- my $res = eval { $callbacks->{'Handler'}->unparsed_entity_decl(@_) };
- if ($@) {
- die $@;
- }
- else {
- # I think there's a buggette here...
- # if the first call throws an exception, we don't set it up right.
- # Not fatal, but we might want to address it.
- my $handler = $callbacks->{'Handler'};
- $self->{Methods}->{'unparsed_entity_decl'} = sub { $handler->unparsed_entity_decl(@_) };
- }
- return $res;
- }
- else {
- $self->{Methods}->{'unparsed_entity_decl'} = sub { };
- }
- }
-
-}
-
-sub processing_instruction {
- my $self = shift;
- if (defined $self->{Methods}->{'processing_instruction'}) {
- $self->{Methods}->{'processing_instruction'}->(@_);
- }
- else {
- my $method;
- my $callbacks;
- if (exists $self->{ParseOptions}) {
- $callbacks = $self->{ParseOptions};
- }
- else {
- $callbacks = $self;
- }
- if (0) { # dummy to make elsif's below compile
- }
- elsif (defined $callbacks->{'ContentHandler'} and $method = $callbacks->{'ContentHandler'}->can('processing_instruction') ) {
- my $handler = $callbacks->{'ContentHandler'};
- $self->{Methods}->{'processing_instruction'} = sub { $method->($handler, @_) };
- return $method->($handler, @_);
- }
- elsif (defined $callbacks->{'DocumentHandler'} and $method = $callbacks->{'DocumentHandler'}->can('processing_instruction') ) {
- my $handler = $callbacks->{'DocumentHandler'};
- $self->{Methods}->{'processing_instruction'} = sub { $method->($handler, @_) };
- return $method->($handler, @_);
- }
- elsif (defined $callbacks->{'Handler'} and $method = $callbacks->{'Handler'}->can('processing_instruction') ) {
- my $handler = $callbacks->{'Handler'};
- $self->{Methods}->{'processing_instruction'} = sub { $method->($handler, @_) };
- return $method->($handler, @_);
- }
- elsif (defined $callbacks->{'ContentHandler'}
- and $callbacks->{'ContentHandler'}->can('AUTOLOAD')
- and $callbacks->{'ContentHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '')
- )
- {
- my $res = eval { $callbacks->{'ContentHandler'}->processing_instruction(@_) };
- if ($@) {
- die $@;
- }
- else {
- # I think there's a buggette here...
- # if the first call throws an exception, we don't set it up right.
- # Not fatal, but we might want to address it.
- my $handler = $callbacks->{'ContentHandler'};
- $self->{Methods}->{'processing_instruction'} = sub { $handler->processing_instruction(@_) };
- }
- return $res;
- }
- elsif (defined $callbacks->{'DocumentHandler'}
- and $callbacks->{'DocumentHandler'}->can('AUTOLOAD')
- and $callbacks->{'DocumentHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '')
- )
- {
- my $res = eval { $callbacks->{'DocumentHandler'}->processing_instruction(@_) };
- if ($@) {
- die $@;
- }
- else {
- # I think there's a buggette here...
- # if the first call throws an exception, we don't set it up right.
- # Not fatal, but we might want to address it.
- my $handler = $callbacks->{'DocumentHandler'};
- $self->{Methods}->{'processing_instruction'} = sub { $handler->processing_instruction(@_) };
- }
- return $res;
- }
- elsif (defined $callbacks->{'Handler'}
- and $callbacks->{'Handler'}->can('AUTOLOAD')
- and $callbacks->{'Handler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '')
- )
- {
- my $res = eval { $callbacks->{'Handler'}->processing_instruction(@_) };
- if ($@) {
- die $@;
- }
- else {
- # I think there's a buggette here...
- # if the first call throws an exception, we don't set it up right.
- # Not fatal, but we might want to address it.
- my $handler = $callbacks->{'Handler'};
- $self->{Methods}->{'processing_instruction'} = sub { $handler->processing_instruction(@_) };
- }
- return $res;
- }
- else {
- $self->{Methods}->{'processing_instruction'} = sub { };
- }
- }
-
-}
-
-sub attribute_decl {
- my $self = shift;
- if (defined $self->{Methods}->{'attribute_decl'}) {
- $self->{Methods}->{'attribute_decl'}->(@_);
- }
- else {
- my $method;
- my $callbacks;
- if (exists $self->{ParseOptions}) {
- $callbacks = $self->{ParseOptions};
- }
- else {
- $callbacks = $self;
- }
- if (0) { # dummy to make elsif's below compile
- }
- elsif (defined $callbacks->{'DeclHandler'} and $method = $callbacks->{'DeclHandler'}->can('attribute_decl') ) {
- my $handler = $callbacks->{'DeclHandler'};
- $self->{Methods}->{'attribute_decl'} = sub { $method->($handler, @_) };
- return $method->($handler, @_);
- }
- elsif (defined $callbacks->{'Handler'} and $method = $callbacks->{'Handler'}->can('attribute_decl') ) {
- my $handler = $callbacks->{'Handler'};
- $self->{Methods}->{'attribute_decl'} = sub { $method->($handler, @_) };
- return $method->($handler, @_);
- }
- elsif (defined $callbacks->{'DeclHandler'}
- and $callbacks->{'DeclHandler'}->can('AUTOLOAD')
- and $callbacks->{'DeclHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '')
- )
- {
- my $res = eval { $callbacks->{'DeclHandler'}->attribute_decl(@_) };
- if ($@) {
- die $@;
- }
- else {
- # I think there's a buggette here...
- # if the first call throws an exception, we don't set it up right.
- # Not fatal, but we might want to address it.
- my $handler = $callbacks->{'DeclHandler'};
- $self->{Methods}->{'attribute_decl'} = sub { $handler->attribute_decl(@_) };
- }
- return $res;
- }
- elsif (defined $callbacks->{'Handler'}
- and $callbacks->{'Handler'}->can('AUTOLOAD')
- and $callbacks->{'Handler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '')
- )
- {
- my $res = eval { $callbacks->{'Handler'}->attribute_decl(@_) };
- if ($@) {
- die $@;
- }
- else {
- # I think there's a buggette here...
- # if the first call throws an exception, we don't set it up right.
- # Not fatal, but we might want to address it.
- my $handler = $callbacks->{'Handler'};
- $self->{Methods}->{'attribute_decl'} = sub { $handler->attribute_decl(@_) };
- }
- return $res;
- }
- else {
- $self->{Methods}->{'attribute_decl'} = sub { };
- }
- }
-
-}
-
-sub fatal_error {
- my $self = shift;
- if (defined $self->{Methods}->{'fatal_error'}) {
- $self->{Methods}->{'fatal_error'}->(@_);
- }
- else {
- my $method;
- my $callbacks;
- if (exists $self->{ParseOptions}) {
- $callbacks = $self->{ParseOptions};
- }
- else {
- $callbacks = $self;
- }
- if (0) { # dummy to make elsif's below compile
- }
- elsif (defined $callbacks->{'ErrorHandler'} and $method = $callbacks->{'ErrorHandler'}->can('fatal_error') ) {
- my $handler = $callbacks->{'ErrorHandler'};
- $self->{Methods}->{'fatal_error'} = sub { $method->($handler, @_) };
- return $method->($handler, @_);
- }
- elsif (defined $callbacks->{'Handler'} and $method = $callbacks->{'Handler'}->can('fatal_error') ) {
- my $handler = $callbacks->{'Handler'};
- $self->{Methods}->{'fatal_error'} = sub { $method->($handler, @_) };
- return $method->($handler, @_);
- }
- elsif (defined $callbacks->{'ErrorHandler'}
- and $callbacks->{'ErrorHandler'}->can('AUTOLOAD')
- and $callbacks->{'ErrorHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '')
- )
- {
- my $res = eval { $callbacks->{'ErrorHandler'}->fatal_error(@_) };
- if ($@) {
- die $@;
- }
- else {
- # I think there's a buggette here...
- # if the first call throws an exception, we don't set it up right.
- # Not fatal, but we might want to address it.
- my $handler = $callbacks->{'ErrorHandler'};
- $self->{Methods}->{'fatal_error'} = sub { $handler->fatal_error(@_) };
- }
- return $res;
- }
- elsif (defined $callbacks->{'Handler'}
- and $callbacks->{'Handler'}->can('AUTOLOAD')
- and $callbacks->{'Handler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '')
- )
- {
- my $res = eval { $callbacks->{'Handler'}->fatal_error(@_) };
- if ($@) {
- die $@;
- }
- else {
- # I think there's a buggette here...
- # if the first call throws an exception, we don't set it up right.
- # Not fatal, but we might want to address it.
- my $handler = $callbacks->{'Handler'};
- $self->{Methods}->{'fatal_error'} = sub { $handler->fatal_error(@_) };
- }
- return $res;
- }
- else {
- $self->{Methods}->{'fatal_error'} = sub { };
- }
- }
-
-}
-
-sub end_cdata {
- my $self = shift;
- if (defined $self->{Methods}->{'end_cdata'}) {
- $self->{Methods}->{'end_cdata'}->(@_);
- }
- else {
- my $method;
- my $callbacks;
- if (exists $self->{ParseOptions}) {
- $callbacks = $self->{ParseOptions};
- }
- else {
- $callbacks = $self;
- }
- if (0) { # dummy to make elsif's below compile
- }
- elsif (defined $callbacks->{'DocumentHandler'} and $method = $callbacks->{'DocumentHandler'}->can('end_cdata') ) {
- my $handler = $callbacks->{'DocumentHandler'};
- $self->{Methods}->{'end_cdata'} = sub { $method->($handler, @_) };
- return $method->($handler, @_);
- }
- elsif (defined $callbacks->{'LexicalHandler'} and $method = $callbacks->{'LexicalHandler'}->can('end_cdata') ) {
- my $handler = $callbacks->{'LexicalHandler'};
- $self->{Methods}->{'end_cdata'} = sub { $method->($handler, @_) };
- return $method->($handler, @_);
- }
- elsif (defined $callbacks->{'Handler'} and $method = $callbacks->{'Handler'}->can('end_cdata') ) {
- my $handler = $callbacks->{'Handler'};
- $self->{Methods}->{'end_cdata'} = sub { $method->($handler, @_) };
- return $method->($handler, @_);
- }
- elsif (defined $callbacks->{'DocumentHandler'}
- and $callbacks->{'DocumentHandler'}->can('AUTOLOAD')
- and $callbacks->{'DocumentHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '')
- )
- {
- my $res = eval { $callbacks->{'DocumentHandler'}->end_cdata(@_) };
- if ($@) {
- die $@;
- }
- else {
- # I think there's a buggette here...
- # if the first call throws an exception, we don't set it up right.
- # Not fatal, but we might want to address it.
- my $handler = $callbacks->{'DocumentHandler'};
- $self->{Methods}->{'end_cdata'} = sub { $handler->end_cdata(@_) };
- }
- return $res;
- }
- elsif (defined $callbacks->{'LexicalHandler'}
- and $callbacks->{'LexicalHandler'}->can('AUTOLOAD')
- and $callbacks->{'LexicalHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '')
- )
- {
- my $res = eval { $callbacks->{'LexicalHandler'}->end_cdata(@_) };
- if ($@) {
- die $@;
- }
- else {
- # I think there's a buggette here...
- # if the first call throws an exception, we don't set it up right.
- # Not fatal, but we might want to address it.
- my $handler = $callbacks->{'LexicalHandler'};
- $self->{Methods}->{'end_cdata'} = sub { $handler->end_cdata(@_) };
- }
- return $res;
- }
- elsif (defined $callbacks->{'Handler'}
- and $callbacks->{'Handler'}->can('AUTOLOAD')
- and $callbacks->{'Handler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '')
- )
- {
- my $res = eval { $callbacks->{'Handler'}->end_cdata(@_) };
- if ($@) {
- die $@;
- }
- else {
- # I think there's a buggette here...
- # if the first call throws an exception, we don't set it up right.
- # Not fatal, but we might want to address it.
- my $handler = $callbacks->{'Handler'};
- $self->{Methods}->{'end_cdata'} = sub { $handler->end_cdata(@_) };
- }
- return $res;
- }
- else {
- $self->{Methods}->{'end_cdata'} = sub { };
- }
- }
-
-}
-
-sub start_entity {
- my $self = shift;
- if (defined $self->{Methods}->{'start_entity'}) {
- $self->{Methods}->{'start_entity'}->(@_);
- }
- else {
- my $method;
- my $callbacks;
- if (exists $self->{ParseOptions}) {
- $callbacks = $self->{ParseOptions};
- }
- else {
- $callbacks = $self;
- }
- if (0) { # dummy to make elsif's below compile
- }
- elsif (defined $callbacks->{'LexicalHandler'} and $method = $callbacks->{'LexicalHandler'}->can('start_entity') ) {
- my $handler = $callbacks->{'LexicalHandler'};
- $self->{Methods}->{'start_entity'} = sub { $method->($handler, @_) };
- return $method->($handler, @_);
- }
- elsif (defined $callbacks->{'Handler'} and $method = $callbacks->{'Handler'}->can('start_entity') ) {
- my $handler = $callbacks->{'Handler'};
- $self->{Methods}->{'start_entity'} = sub { $method->($handler, @_) };
- return $method->($handler, @_);
- }
- elsif (defined $callbacks->{'LexicalHandler'}
- and $callbacks->{'LexicalHandler'}->can('AUTOLOAD')
- and $callbacks->{'LexicalHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '')
- )
- {
- my $res = eval { $callbacks->{'LexicalHandler'}->start_entity(@_) };
- if ($@) {
- die $@;
- }
- else {
- # I think there's a buggette here...
- # if the first call throws an exception, we don't set it up right.
- # Not fatal, but we might want to address it.
- my $handler = $callbacks->{'LexicalHandler'};
- $self->{Methods}->{'start_entity'} = sub { $handler->start_entity(@_) };
- }
- return $res;
- }
- elsif (defined $callbacks->{'Handler'}
- and $callbacks->{'Handler'}->can('AUTOLOAD')
- and $callbacks->{'Handler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '')
- )
- {
- my $res = eval { $callbacks->{'Handler'}->start_entity(@_) };
- if ($@) {
- die $@;
- }
- else {
- # I think there's a buggette here...
- # if the first call throws an exception, we don't set it up right.
- # Not fatal, but we might want to address it.
- my $handler = $callbacks->{'Handler'};
- $self->{Methods}->{'start_entity'} = sub { $handler->start_entity(@_) };
- }
- return $res;
- }
- else {
- $self->{Methods}->{'start_entity'} = sub { };
- }
- }
-
-}
-
-sub start_prefix_mapping {
- my $self = shift;
- if (defined $self->{Methods}->{'start_prefix_mapping'}) {
- $self->{Methods}->{'start_prefix_mapping'}->(@_);
- }
- else {
- my $method;
- my $callbacks;
- if (exists $self->{ParseOptions}) {
- $callbacks = $self->{ParseOptions};
- }
- else {
- $callbacks = $self;
- }
- if (0) { # dummy to make elsif's below compile
- }
- elsif (defined $callbacks->{'ContentHandler'} and $method = $callbacks->{'ContentHandler'}->can('start_prefix_mapping') ) {
- my $handler = $callbacks->{'ContentHandler'};
- $self->{Methods}->{'start_prefix_mapping'} = sub { $method->($handler, @_) };
- return $method->($handler, @_);
- }
- elsif (defined $callbacks->{'Handler'} and $method = $callbacks->{'Handler'}->can('start_prefix_mapping') ) {
- my $handler = $callbacks->{'Handler'};
- $self->{Methods}->{'start_prefix_mapping'} = sub { $method->($handler, @_) };
- return $method->($handler, @_);
- }
- elsif (defined $callbacks->{'ContentHandler'}
- and $callbacks->{'ContentHandler'}->can('AUTOLOAD')
- and $callbacks->{'ContentHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '')
- )
- {
- my $res = eval { $callbacks->{'ContentHandler'}->start_prefix_mapping(@_) };
- if ($@) {
- die $@;
- }
- else {
- # I think there's a buggette here...
- # if the first call throws an exception, we don't set it up right.
- # Not fatal, but we might want to address it.
- my $handler = $callbacks->{'ContentHandler'};
- $self->{Methods}->{'start_prefix_mapping'} = sub { $handler->start_prefix_mapping(@_) };
- }
- return $res;
- }
- elsif (defined $callbacks->{'Handler'}
- and $callbacks->{'Handler'}->can('AUTOLOAD')
- and $callbacks->{'Handler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '')
- )
- {
- my $res = eval { $callbacks->{'Handler'}->start_prefix_mapping(@_) };
- if ($@) {
- die $@;
- }
- else {
- # I think there's a buggette here...
- # if the first call throws an exception, we don't set it up right.
- # Not fatal, but we might want to address it.
- my $handler = $callbacks->{'Handler'};
- $self->{Methods}->{'start_prefix_mapping'} = sub { $handler->start_prefix_mapping(@_) };
- }
- return $res;
- }
- else {
- $self->{Methods}->{'start_prefix_mapping'} = sub { };
- }
- }
-
-}
-
-sub error {
- my $self = shift;
- if (defined $self->{Methods}->{'error'}) {
- $self->{Methods}->{'error'}->(@_);
- }
- else {
- my $method;
- my $callbacks;
- if (exists $self->{ParseOptions}) {
- $callbacks = $self->{ParseOptions};
- }
- else {
- $callbacks = $self;
- }
- if (0) { # dummy to make elsif's below compile
- }
- elsif (defined $callbacks->{'ErrorHandler'} and $method = $callbacks->{'ErrorHandler'}->can('error') ) {
- my $handler = $callbacks->{'ErrorHandler'};
- $self->{Methods}->{'error'} = sub { $method->($handler, @_) };
- return $method->($handler, @_);
- }
- elsif (defined $callbacks->{'Handler'} and $method = $callbacks->{'Handler'}->can('error') ) {
- my $handler = $callbacks->{'Handler'};
- $self->{Methods}->{'error'} = sub { $method->($handler, @_) };
- return $method->($handler, @_);
- }
- elsif (defined $callbacks->{'ErrorHandler'}
- and $callbacks->{'ErrorHandler'}->can('AUTOLOAD')
- and $callbacks->{'ErrorHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '')
- )
- {
- my $res = eval { $callbacks->{'ErrorHandler'}->error(@_) };
- if ($@) {
- die $@;
- }
- else {
- # I think there's a buggette here...
- # if the first call throws an exception, we don't set it up right.
- # Not fatal, but we might want to address it.
- my $handler = $callbacks->{'ErrorHandler'};
- $self->{Methods}->{'error'} = sub { $handler->error(@_) };
- }
- return $res;
- }
- elsif (defined $callbacks->{'Handler'}
- and $callbacks->{'Handler'}->can('AUTOLOAD')
- and $callbacks->{'Handler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '')
- )
- {
- my $res = eval { $callbacks->{'Handler'}->error(@_) };
- if ($@) {
- die $@;
- }
- else {
- # I think there's a buggette here...
- # if the first call throws an exception, we don't set it up right.
- # Not fatal, but we might want to address it.
- my $handler = $callbacks->{'Handler'};
- $self->{Methods}->{'error'} = sub { $handler->error(@_) };
- }
- return $res;
- }
- else {
- $self->{Methods}->{'error'} = sub { };
- }
- }
-
-}
-
-sub start_document {
- my $self = shift;
- if (defined $self->{Methods}->{'start_document'}) {
- $self->{Methods}->{'start_document'}->(@_);
- }
- else {
- my $method;
- my $callbacks;
- if (exists $self->{ParseOptions}) {
- $callbacks = $self->{ParseOptions};
- }
- else {
- $callbacks = $self;
- }
- if (0) { # dummy to make elsif's below compile
- }
- elsif (defined $callbacks->{'ContentHandler'} and $method = $callbacks->{'ContentHandler'}->can('start_document') ) {
- my $handler = $callbacks->{'ContentHandler'};
- $self->{Methods}->{'start_document'} = sub { $method->($handler, @_) };
- return $method->($handler, @_);
- }
- elsif (defined $callbacks->{'DocumentHandler'} and $method = $callbacks->{'DocumentHandler'}->can('start_document') ) {
- my $handler = $callbacks->{'DocumentHandler'};
- $self->{Methods}->{'start_document'} = sub { $method->($handler, @_) };
- return $method->($handler, @_);
- }
- elsif (defined $callbacks->{'Handler'} and $method = $callbacks->{'Handler'}->can('start_document') ) {
- my $handler = $callbacks->{'Handler'};
- $self->{Methods}->{'start_document'} = sub { $method->($handler, @_) };
- return $method->($handler, @_);
- }
- elsif (defined $callbacks->{'ContentHandler'}
- and $callbacks->{'ContentHandler'}->can('AUTOLOAD')
- and $callbacks->{'ContentHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '')
- )
- {
- my $res = eval { $callbacks->{'ContentHandler'}->start_document(@_) };
- if ($@) {
- die $@;
- }
- else {
- # I think there's a buggette here...
- # if the first call throws an exception, we don't set it up right.
- # Not fatal, but we might want to address it.
- my $handler = $callbacks->{'ContentHandler'};
- $self->{Methods}->{'start_document'} = sub { $handler->start_document(@_) };
- }
- return $res;
- }
- elsif (defined $callbacks->{'DocumentHandler'}
- and $callbacks->{'DocumentHandler'}->can('AUTOLOAD')
- and $callbacks->{'DocumentHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '')
- )
- {
- my $res = eval { $callbacks->{'DocumentHandler'}->start_document(@_) };
- if ($@) {
- die $@;
- }
- else {
- # I think there's a buggette here...
- # if the first call throws an exception, we don't set it up right.
- # Not fatal, but we might want to address it.
- my $handler = $callbacks->{'DocumentHandler'};
- $self->{Methods}->{'start_document'} = sub { $handler->start_document(@_) };
- }
- return $res;
- }
- elsif (defined $callbacks->{'Handler'}
- and $callbacks->{'Handler'}->can('AUTOLOAD')
- and $callbacks->{'Handler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '')
- )
- {
- my $res = eval { $callbacks->{'Handler'}->start_document(@_) };
- if ($@) {
- die $@;
- }
- else {
- # I think there's a buggette here...
- # if the first call throws an exception, we don't set it up right.
- # Not fatal, but we might want to address it.
- my $handler = $callbacks->{'Handler'};
- $self->{Methods}->{'start_document'} = sub { $handler->start_document(@_) };
- }
- return $res;
- }
- else {
- $self->{Methods}->{'start_document'} = sub { };
- }
- }
-
-}
-
-sub ignorable_whitespace {
- my $self = shift;
- if (defined $self->{Methods}->{'ignorable_whitespace'}) {
- $self->{Methods}->{'ignorable_whitespace'}->(@_);
- }
- else {
- my $method;
- my $callbacks;
- if (exists $self->{ParseOptions}) {
- $callbacks = $self->{ParseOptions};
- }
- else {
- $callbacks = $self;
- }
- if (0) { # dummy to make elsif's below compile
- }
- elsif (defined $callbacks->{'ContentHandler'} and $method = $callbacks->{'ContentHandler'}->can('ignorable_whitespace') ) {
- my $handler = $callbacks->{'ContentHandler'};
- $self->{Methods}->{'ignorable_whitespace'} = sub { $method->($handler, @_) };
- return $method->($handler, @_);
- }
- elsif (defined $callbacks->{'DocumentHandler'} and $method = $callbacks->{'DocumentHandler'}->can('ignorable_whitespace') ) {
- my $handler = $callbacks->{'DocumentHandler'};
- $self->{Methods}->{'ignorable_whitespace'} = sub { $method->($handler, @_) };
- return $method->($handler, @_);
- }
- elsif (defined $callbacks->{'Handler'} and $method = $callbacks->{'Handler'}->can('ignorable_whitespace') ) {
- my $handler = $callbacks->{'Handler'};
- $self->{Methods}->{'ignorable_whitespace'} = sub { $method->($handler, @_) };
- return $method->($handler, @_);
- }
- elsif (defined $callbacks->{'ContentHandler'}
- and $callbacks->{'ContentHandler'}->can('AUTOLOAD')
- and $callbacks->{'ContentHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '')
- )
- {
- my $res = eval { $callbacks->{'ContentHandler'}->ignorable_whitespace(@_) };
- if ($@) {
- die $@;
- }
- else {
- # I think there's a buggette here...
- # if the first call throws an exception, we don't set it up right.
- # Not fatal, but we might want to address it.
- my $handler = $callbacks->{'ContentHandler'};
- $self->{Methods}->{'ignorable_whitespace'} = sub { $handler->ignorable_whitespace(@_) };
- }
- return $res;
- }
- elsif (defined $callbacks->{'DocumentHandler'}
- and $callbacks->{'DocumentHandler'}->can('AUTOLOAD')
- and $callbacks->{'DocumentHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '')
- )
- {
- my $res = eval { $callbacks->{'DocumentHandler'}->ignorable_whitespace(@_) };
- if ($@) {
- die $@;
- }
- else {
- # I think there's a buggette here...
- # if the first call throws an exception, we don't set it up right.
- # Not fatal, but we might want to address it.
- my $handler = $callbacks->{'DocumentHandler'};
- $self->{Methods}->{'ignorable_whitespace'} = sub { $handler->ignorable_whitespace(@_) };
- }
- return $res;
- }
- elsif (defined $callbacks->{'Handler'}
- and $callbacks->{'Handler'}->can('AUTOLOAD')
- and $callbacks->{'Handler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '')
- )
- {
- my $res = eval { $callbacks->{'Handler'}->ignorable_whitespace(@_) };
- if ($@) {
- die $@;
- }
- else {
- # I think there's a buggette here...
- # if the first call throws an exception, we don't set it up right.
- # Not fatal, but we might want to address it.
- my $handler = $callbacks->{'Handler'};
- $self->{Methods}->{'ignorable_whitespace'} = sub { $handler->ignorable_whitespace(@_) };
- }
- return $res;
- }
- else {
- $self->{Methods}->{'ignorable_whitespace'} = sub { };
- }
- }
-
-}
-
-sub end_document {
- my $self = shift;
- if (defined $self->{Methods}->{'end_document'}) {
- $self->{Methods}->{'end_document'}->(@_);
- }
- else {
- my $method;
- my $callbacks;
- if (exists $self->{ParseOptions}) {
- $callbacks = $self->{ParseOptions};
- }
- else {
- $callbacks = $self;
- }
- if (0) { # dummy to make elsif's below compile
- }
- elsif (defined $callbacks->{'ContentHandler'} and $method = $callbacks->{'ContentHandler'}->can('end_document') ) {
- my $handler = $callbacks->{'ContentHandler'};
- $self->{Methods}->{'end_document'} = sub { $method->($handler, @_) };
- return $method->($handler, @_);
- }
- elsif (defined $callbacks->{'DocumentHandler'} and $method = $callbacks->{'DocumentHandler'}->can('end_document') ) {
- my $handler = $callbacks->{'DocumentHandler'};
- $self->{Methods}->{'end_document'} = sub { $method->($handler, @_) };
- return $method->($handler, @_);
- }
- elsif (defined $callbacks->{'Handler'} and $method = $callbacks->{'Handler'}->can('end_document') ) {
- my $handler = $callbacks->{'Handler'};
- $self->{Methods}->{'end_document'} = sub { $method->($handler, @_) };
- return $method->($handler, @_);
- }
- elsif (defined $callbacks->{'ContentHandler'}
- and $callbacks->{'ContentHandler'}->can('AUTOLOAD')
- and $callbacks->{'ContentHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '')
- )
- {
- my $res = eval { $callbacks->{'ContentHandler'}->end_document(@_) };
- if ($@) {
- die $@;
- }
- else {
- # I think there's a buggette here...
- # if the first call throws an exception, we don't set it up right.
- # Not fatal, but we might want to address it.
- my $handler = $callbacks->{'ContentHandler'};
- $self->{Methods}->{'end_document'} = sub { $handler->end_document(@_) };
- }
- return $res;
- }
- elsif (defined $callbacks->{'DocumentHandler'}
- and $callbacks->{'DocumentHandler'}->can('AUTOLOAD')
- and $callbacks->{'DocumentHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '')
- )
- {
- my $res = eval { $callbacks->{'DocumentHandler'}->end_document(@_) };
- if ($@) {
- die $@;
- }
- else {
- # I think there's a buggette here...
- # if the first call throws an exception, we don't set it up right.
- # Not fatal, but we might want to address it.
- my $handler = $callbacks->{'DocumentHandler'};
- $self->{Methods}->{'end_document'} = sub { $handler->end_document(@_) };
- }
- return $res;
- }
- elsif (defined $callbacks->{'Handler'}
- and $callbacks->{'Handler'}->can('AUTOLOAD')
- and $callbacks->{'Handler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '')
- )
- {
- my $res = eval { $callbacks->{'Handler'}->end_document(@_) };
- if ($@) {
- die $@;
- }
- else {
- # I think there's a buggette here...
- # if the first call throws an exception, we don't set it up right.
- # Not fatal, but we might want to address it.
- my $handler = $callbacks->{'Handler'};
- $self->{Methods}->{'end_document'} = sub { $handler->end_document(@_) };
- }
- return $res;
- }
- else {
- $self->{Methods}->{'end_document'} = sub { };
- }
- }
-
-}
-
-sub start_cdata {
- my $self = shift;
- if (defined $self->{Methods}->{'start_cdata'}) {
- $self->{Methods}->{'start_cdata'}->(@_);
- }
- else {
- my $method;
- my $callbacks;
- if (exists $self->{ParseOptions}) {
- $callbacks = $self->{ParseOptions};
- }
- else {
- $callbacks = $self;
- }
- if (0) { # dummy to make elsif's below compile
- }
- elsif (defined $callbacks->{'DocumentHandler'} and $method = $callbacks->{'DocumentHandler'}->can('start_cdata') ) {
- my $handler = $callbacks->{'DocumentHandler'};
- $self->{Methods}->{'start_cdata'} = sub { $method->($handler, @_) };
- return $method->($handler, @_);
- }
- elsif (defined $callbacks->{'LexicalHandler'} and $method = $callbacks->{'LexicalHandler'}->can('start_cdata') ) {
- my $handler = $callbacks->{'LexicalHandler'};
- $self->{Methods}->{'start_cdata'} = sub { $method->($handler, @_) };
- return $method->($handler, @_);
- }
- elsif (defined $callbacks->{'Handler'} and $method = $callbacks->{'Handler'}->can('start_cdata') ) {
- my $handler = $callbacks->{'Handler'};
- $self->{Methods}->{'start_cdata'} = sub { $method->($handler, @_) };
- return $method->($handler, @_);
- }
- elsif (defined $callbacks->{'DocumentHandler'}
- and $callbacks->{'DocumentHandler'}->can('AUTOLOAD')
- and $callbacks->{'DocumentHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '')
- )
- {
- my $res = eval { $callbacks->{'DocumentHandler'}->start_cdata(@_) };
- if ($@) {
- die $@;
- }
- else {
- # I think there's a buggette here...
- # if the first call throws an exception, we don't set it up right.
- # Not fatal, but we might want to address it.
- my $handler = $callbacks->{'DocumentHandler'};
- $self->{Methods}->{'start_cdata'} = sub { $handler->start_cdata(@_) };
- }
- return $res;
- }
- elsif (defined $callbacks->{'LexicalHandler'}
- and $callbacks->{'LexicalHandler'}->can('AUTOLOAD')
- and $callbacks->{'LexicalHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '')
- )
- {
- my $res = eval { $callbacks->{'LexicalHandler'}->start_cdata(@_) };
- if ($@) {
- die $@;
- }
- else {
- # I think there's a buggette here...
- # if the first call throws an exception, we don't set it up right.
- # Not fatal, but we might want to address it.
- my $handler = $callbacks->{'LexicalHandler'};
- $self->{Methods}->{'start_cdata'} = sub { $handler->start_cdata(@_) };
- }
- return $res;
- }
- elsif (defined $callbacks->{'Handler'}
- and $callbacks->{'Handler'}->can('AUTOLOAD')
- and $callbacks->{'Handler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '')
- )
- {
- my $res = eval { $callbacks->{'Handler'}->start_cdata(@_) };
- if ($@) {
- die $@;
- }
- else {
- # I think there's a buggette here...
- # if the first call throws an exception, we don't set it up right.
- # Not fatal, but we might want to address it.
- my $handler = $callbacks->{'Handler'};
- $self->{Methods}->{'start_cdata'} = sub { $handler->start_cdata(@_) };
- }
- return $res;
- }
- else {
- $self->{Methods}->{'start_cdata'} = sub { };
- }
- }
-
-}
-
-sub set_document_locator {
- my $self = shift;
- if (defined $self->{Methods}->{'set_document_locator'}) {
- $self->{Methods}->{'set_document_locator'}->(@_);
- }
- else {
- my $method;
- my $callbacks;
- if (exists $self->{ParseOptions}) {
- $callbacks = $self->{ParseOptions};
- }
- else {
- $callbacks = $self;
- }
- if (0) { # dummy to make elsif's below compile
- }
- elsif (defined $callbacks->{'ContentHandler'} and $method = $callbacks->{'ContentHandler'}->can('set_document_locator') ) {
- my $handler = $callbacks->{'ContentHandler'};
- $self->{Methods}->{'set_document_locator'} = sub { $method->($handler, @_) };
- return $method->($handler, @_);
- }
- elsif (defined $callbacks->{'DocumentHandler'} and $method = $callbacks->{'DocumentHandler'}->can('set_document_locator') ) {
- my $handler = $callbacks->{'DocumentHandler'};
- $self->{Methods}->{'set_document_locator'} = sub { $method->($handler, @_) };
- return $method->($handler, @_);
- }
- elsif (defined $callbacks->{'Handler'} and $method = $callbacks->{'Handler'}->can('set_document_locator') ) {
- my $handler = $callbacks->{'Handler'};
- $self->{Methods}->{'set_document_locator'} = sub { $method->($handler, @_) };
- return $method->($handler, @_);
- }
- elsif (defined $callbacks->{'ContentHandler'}
- and $callbacks->{'ContentHandler'}->can('AUTOLOAD')
- and $callbacks->{'ContentHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '')
- )
- {
- my $res = eval { $callbacks->{'ContentHandler'}->set_document_locator(@_) };
- if ($@) {
- die $@;
- }
- else {
- # I think there's a buggette here...
- # if the first call throws an exception, we don't set it up right.
- # Not fatal, but we might want to address it.
- my $handler = $callbacks->{'ContentHandler'};
- $self->{Methods}->{'set_document_locator'} = sub { $handler->set_document_locator(@_) };
- }
- return $res;
- }
- elsif (defined $callbacks->{'DocumentHandler'}
- and $callbacks->{'DocumentHandler'}->can('AUTOLOAD')
- and $callbacks->{'DocumentHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '')
- )
- {
- my $res = eval { $callbacks->{'DocumentHandler'}->set_document_locator(@_) };
- if ($@) {
- die $@;
- }
- else {
- # I think there's a buggette here...
- # if the first call throws an exception, we don't set it up right.
- # Not fatal, but we might want to address it.
- my $handler = $callbacks->{'DocumentHandler'};
- $self->{Methods}->{'set_document_locator'} = sub { $handler->set_document_locator(@_) };
- }
- return $res;
- }
- elsif (defined $callbacks->{'Handler'}
- and $callbacks->{'Handler'}->can('AUTOLOAD')
- and $callbacks->{'Handler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '')
- )
- {
- my $res = eval { $callbacks->{'Handler'}->set_document_locator(@_) };
- if ($@) {
- die $@;
- }
- else {
- # I think there's a buggette here...
- # if the first call throws an exception, we don't set it up right.
- # Not fatal, but we might want to address it.
- my $handler = $callbacks->{'Handler'};
- $self->{Methods}->{'set_document_locator'} = sub { $handler->set_document_locator(@_) };
- }
- return $res;
- }
- else {
- $self->{Methods}->{'set_document_locator'} = sub { };
- }
- }
-
-}
-
-sub attlist_decl {
- my $self = shift;
- if (defined $self->{Methods}->{'attlist_decl'}) {
- $self->{Methods}->{'attlist_decl'}->(@_);
- }
- else {
- my $method;
- my $callbacks;
- if (exists $self->{ParseOptions}) {
- $callbacks = $self->{ParseOptions};
- }
- else {
- $callbacks = $self;
- }
- if (0) { # dummy to make elsif's below compile
- }
- elsif (defined $callbacks->{'DTDHandler'} and $method = $callbacks->{'DTDHandler'}->can('attlist_decl') ) {
- my $handler = $callbacks->{'DTDHandler'};
- $self->{Methods}->{'attlist_decl'} = sub { $method->($handler, @_) };
- return $method->($handler, @_);
- }
- elsif (defined $callbacks->{'Handler'} and $method = $callbacks->{'Handler'}->can('attlist_decl') ) {
- my $handler = $callbacks->{'Handler'};
- $self->{Methods}->{'attlist_decl'} = sub { $method->($handler, @_) };
- return $method->($handler, @_);
- }
- elsif (defined $callbacks->{'DTDHandler'}
- and $callbacks->{'DTDHandler'}->can('AUTOLOAD')
- and $callbacks->{'DTDHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '')
- )
- {
- my $res = eval { $callbacks->{'DTDHandler'}->attlist_decl(@_) };
- if ($@) {
- die $@;
- }
- else {
- # I think there's a buggette here...
- # if the first call throws an exception, we don't set it up right.
- # Not fatal, but we might want to address it.
- my $handler = $callbacks->{'DTDHandler'};
- $self->{Methods}->{'attlist_decl'} = sub { $handler->attlist_decl(@_) };
- }
- return $res;
- }
- elsif (defined $callbacks->{'Handler'}
- and $callbacks->{'Handler'}->can('AUTOLOAD')
- and $callbacks->{'Handler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '')
- )
- {
- my $res = eval { $callbacks->{'Handler'}->attlist_decl(@_) };
- if ($@) {
- die $@;
- }
- else {
- # I think there's a buggette here...
- # if the first call throws an exception, we don't set it up right.
- # Not fatal, but we might want to address it.
- my $handler = $callbacks->{'Handler'};
- $self->{Methods}->{'attlist_decl'} = sub { $handler->attlist_decl(@_) };
- }
- return $res;
- }
- else {
- $self->{Methods}->{'attlist_decl'} = sub { };
- }
- }
-
-}
-
-sub start_dtd {
- my $self = shift;
- if (defined $self->{Methods}->{'start_dtd'}) {
- $self->{Methods}->{'start_dtd'}->(@_);
- }
- else {
- my $method;
- my $callbacks;
- if (exists $self->{ParseOptions}) {
- $callbacks = $self->{ParseOptions};
- }
- else {
- $callbacks = $self;
- }
- if (0) { # dummy to make elsif's below compile
- }
- elsif (defined $callbacks->{'LexicalHandler'} and $method = $callbacks->{'LexicalHandler'}->can('start_dtd') ) {
- my $handler = $callbacks->{'LexicalHandler'};
- $self->{Methods}->{'start_dtd'} = sub { $method->($handler, @_) };
- return $method->($handler, @_);
- }
- elsif (defined $callbacks->{'Handler'} and $method = $callbacks->{'Handler'}->can('start_dtd') ) {
- my $handler = $callbacks->{'Handler'};
- $self->{Methods}->{'start_dtd'} = sub { $method->($handler, @_) };
- return $method->($handler, @_);
- }
- elsif (defined $callbacks->{'LexicalHandler'}
- and $callbacks->{'LexicalHandler'}->can('AUTOLOAD')
- and $callbacks->{'LexicalHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '')
- )
- {
- my $res = eval { $callbacks->{'LexicalHandler'}->start_dtd(@_) };
- if ($@) {
- die $@;
- }
- else {
- # I think there's a buggette here...
- # if the first call throws an exception, we don't set it up right.
- # Not fatal, but we might want to address it.
- my $handler = $callbacks->{'LexicalHandler'};
- $self->{Methods}->{'start_dtd'} = sub { $handler->start_dtd(@_) };
- }
- return $res;
- }
- elsif (defined $callbacks->{'Handler'}
- and $callbacks->{'Handler'}->can('AUTOLOAD')
- and $callbacks->{'Handler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '')
- )
- {
- my $res = eval { $callbacks->{'Handler'}->start_dtd(@_) };
- if ($@) {
- die $@;
- }
- else {
- # I think there's a buggette here...
- # if the first call throws an exception, we don't set it up right.
- # Not fatal, but we might want to address it.
- my $handler = $callbacks->{'Handler'};
- $self->{Methods}->{'start_dtd'} = sub { $handler->start_dtd(@_) };
- }
- return $res;
- }
- else {
- $self->{Methods}->{'start_dtd'} = sub { };
- }
- }
-
-}
-
-sub resolve_entity {
- my $self = shift;
- if (defined $self->{Methods}->{'resolve_entity'}) {
- $self->{Methods}->{'resolve_entity'}->(@_);
- }
- else {
- my $method;
- my $callbacks;
- if (exists $self->{ParseOptions}) {
- $callbacks = $self->{ParseOptions};
- }
- else {
- $callbacks = $self;
- }
- if (0) { # dummy to make elsif's below compile
- }
- elsif (defined $callbacks->{'EntityResolver'} and $method = $callbacks->{'EntityResolver'}->can('resolve_entity') ) {
- my $handler = $callbacks->{'EntityResolver'};
- $self->{Methods}->{'resolve_entity'} = sub { $method->($handler, @_) };
- return $method->($handler, @_);
- }
- elsif (defined $callbacks->{'Handler'} and $method = $callbacks->{'Handler'}->can('resolve_entity') ) {
- my $handler = $callbacks->{'Handler'};
- $self->{Methods}->{'resolve_entity'} = sub { $method->($handler, @_) };
- return $method->($handler, @_);
- }
- elsif (defined $callbacks->{'EntityResolver'}
- and $callbacks->{'EntityResolver'}->can('AUTOLOAD')
- and $callbacks->{'EntityResolver'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '')
- )
- {
- my $res = eval { $callbacks->{'EntityResolver'}->resolve_entity(@_) };
- if ($@) {
- die $@;
- }
- else {
- # I think there's a buggette here...
- # if the first call throws an exception, we don't set it up right.
- # Not fatal, but we might want to address it.
- my $handler = $callbacks->{'EntityResolver'};
- $self->{Methods}->{'resolve_entity'} = sub { $handler->resolve_entity(@_) };
- }
- return $res;
- }
- elsif (defined $callbacks->{'Handler'}
- and $callbacks->{'Handler'}->can('AUTOLOAD')
- and $callbacks->{'Handler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '')
- )
- {
- my $res = eval { $callbacks->{'Handler'}->resolve_entity(@_) };
- if ($@) {
- die $@;
- }
- else {
- # I think there's a buggette here...
- # if the first call throws an exception, we don't set it up right.
- # Not fatal, but we might want to address it.
- my $handler = $callbacks->{'Handler'};
- $self->{Methods}->{'resolve_entity'} = sub { $handler->resolve_entity(@_) };
- }
- return $res;
- }
- else {
- $self->{Methods}->{'resolve_entity'} = sub { };
- }
- }
-
-}
-
-sub entity_reference {
- my $self = shift;
- if (defined $self->{Methods}->{'entity_reference'}) {
- $self->{Methods}->{'entity_reference'}->(@_);
- }
- else {
- my $method;
- my $callbacks;
- if (exists $self->{ParseOptions}) {
- $callbacks = $self->{ParseOptions};
- }
- else {
- $callbacks = $self;
- }
- if (0) { # dummy to make elsif's below compile
- }
- elsif (defined $callbacks->{'DocumentHandler'} and $method = $callbacks->{'DocumentHandler'}->can('entity_reference') ) {
- my $handler = $callbacks->{'DocumentHandler'};
- $self->{Methods}->{'entity_reference'} = sub { $method->($handler, @_) };
- return $method->($handler, @_);
- }
- elsif (defined $callbacks->{'Handler'} and $method = $callbacks->{'Handler'}->can('entity_reference') ) {
- my $handler = $callbacks->{'Handler'};
- $self->{Methods}->{'entity_reference'} = sub { $method->($handler, @_) };
- return $method->($handler, @_);
- }
- elsif (defined $callbacks->{'DocumentHandler'}
- and $callbacks->{'DocumentHandler'}->can('AUTOLOAD')
- and $callbacks->{'DocumentHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '')
- )
- {
- my $res = eval { $callbacks->{'DocumentHandler'}->entity_reference(@_) };
- if ($@) {
- die $@;
- }
- else {
- # I think there's a buggette here...
- # if the first call throws an exception, we don't set it up right.
- # Not fatal, but we might want to address it.
- my $handler = $callbacks->{'DocumentHandler'};
- $self->{Methods}->{'entity_reference'} = sub { $handler->entity_reference(@_) };
- }
- return $res;
- }
- elsif (defined $callbacks->{'Handler'}
- and $callbacks->{'Handler'}->can('AUTOLOAD')
- and $callbacks->{'Handler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '')
- )
- {
- my $res = eval { $callbacks->{'Handler'}->entity_reference(@_) };
- if ($@) {
- die $@;
- }
- else {
- # I think there's a buggette here...
- # if the first call throws an exception, we don't set it up right.
- # Not fatal, but we might want to address it.
- my $handler = $callbacks->{'Handler'};
- $self->{Methods}->{'entity_reference'} = sub { $handler->entity_reference(@_) };
- }
- return $res;
- }
- else {
- $self->{Methods}->{'entity_reference'} = sub { };
- }
- }
-
-}
-
-sub element_decl {
- my $self = shift;
- if (defined $self->{Methods}->{'element_decl'}) {
- $self->{Methods}->{'element_decl'}->(@_);
- }
- else {
- my $method;
- my $callbacks;
- if (exists $self->{ParseOptions}) {
- $callbacks = $self->{ParseOptions};
- }
- else {
- $callbacks = $self;
- }
- if (0) { # dummy to make elsif's below compile
- }
- elsif (defined $callbacks->{'DeclHandler'} and $method = $callbacks->{'DeclHandler'}->can('element_decl') ) {
- my $handler = $callbacks->{'DeclHandler'};
- $self->{Methods}->{'element_decl'} = sub { $method->($handler, @_) };
- return $method->($handler, @_);
- }
- elsif (defined $callbacks->{'Handler'} and $method = $callbacks->{'Handler'}->can('element_decl') ) {
- my $handler = $callbacks->{'Handler'};
- $self->{Methods}->{'element_decl'} = sub { $method->($handler, @_) };
- return $method->($handler, @_);
- }
- elsif (defined $callbacks->{'DeclHandler'}
- and $callbacks->{'DeclHandler'}->can('AUTOLOAD')
- and $callbacks->{'DeclHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '')
- )
- {
- my $res = eval { $callbacks->{'DeclHandler'}->element_decl(@_) };
- if ($@) {
- die $@;
- }
- else {
- # I think there's a buggette here...
- # if the first call throws an exception, we don't set it up right.
- # Not fatal, but we might want to address it.
- my $handler = $callbacks->{'DeclHandler'};
- $self->{Methods}->{'element_decl'} = sub { $handler->element_decl(@_) };
- }
- return $res;
- }
- elsif (defined $callbacks->{'Handler'}
- and $callbacks->{'Handler'}->can('AUTOLOAD')
- and $callbacks->{'Handler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '')
- )
- {
- my $res = eval { $callbacks->{'Handler'}->element_decl(@_) };
- if ($@) {
- die $@;
- }
- else {
- # I think there's a buggette here...
- # if the first call throws an exception, we don't set it up right.
- # Not fatal, but we might want to address it.
- my $handler = $callbacks->{'Handler'};
- $self->{Methods}->{'element_decl'} = sub { $handler->element_decl(@_) };
- }
- return $res;
- }
- else {
- $self->{Methods}->{'element_decl'} = sub { };
- }
- }
-
-}
-
-sub notation_decl {
- my $self = shift;
- if (defined $self->{Methods}->{'notation_decl'}) {
- $self->{Methods}->{'notation_decl'}->(@_);
- }
- else {
- my $method;
- my $callbacks;
- if (exists $self->{ParseOptions}) {
- $callbacks = $self->{ParseOptions};
- }
- else {
- $callbacks = $self;
- }
- if (0) { # dummy to make elsif's below compile
- }
- elsif (defined $callbacks->{'DTDHandler'} and $method = $callbacks->{'DTDHandler'}->can('notation_decl') ) {
- my $handler = $callbacks->{'DTDHandler'};
- $self->{Methods}->{'notation_decl'} = sub { $method->($handler, @_) };
- return $method->($handler, @_);
- }
- elsif (defined $callbacks->{'Handler'} and $method = $callbacks->{'Handler'}->can('notation_decl') ) {
- my $handler = $callbacks->{'Handler'};
- $self->{Methods}->{'notation_decl'} = sub { $method->($handler, @_) };
- return $method->($handler, @_);
- }
- elsif (defined $callbacks->{'DTDHandler'}
- and $callbacks->{'DTDHandler'}->can('AUTOLOAD')
- and $callbacks->{'DTDHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '')
- )
- {
- my $res = eval { $callbacks->{'DTDHandler'}->notation_decl(@_) };
- if ($@) {
- die $@;
- }
- else {
- # I think there's a buggette here...
- # if the first call throws an exception, we don't set it up right.
- # Not fatal, but we might want to address it.
- my $handler = $callbacks->{'DTDHandler'};
- $self->{Methods}->{'notation_decl'} = sub { $handler->notation_decl(@_) };
- }
- return $res;
- }
- elsif (defined $callbacks->{'Handler'}
- and $callbacks->{'Handler'}->can('AUTOLOAD')
- and $callbacks->{'Handler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '')
- )
- {
- my $res = eval { $callbacks->{'Handler'}->notation_decl(@_) };
- if ($@) {
- die $@;
- }
- else {
- # I think there's a buggette here...
- # if the first call throws an exception, we don't set it up right.
- # Not fatal, but we might want to address it.
- my $handler = $callbacks->{'Handler'};
- $self->{Methods}->{'notation_decl'} = sub { $handler->notation_decl(@_) };
- }
- return $res;
- }
- else {
- $self->{Methods}->{'notation_decl'} = sub { };
- }
- }
-
-}
-
-sub skipped_entity {
- my $self = shift;
- if (defined $self->{Methods}->{'skipped_entity'}) {
- $self->{Methods}->{'skipped_entity'}->(@_);
- }
- else {
- my $method;
- my $callbacks;
- if (exists $self->{ParseOptions}) {
- $callbacks = $self->{ParseOptions};
- }
- else {
- $callbacks = $self;
- }
- if (0) { # dummy to make elsif's below compile
- }
- elsif (defined $callbacks->{'ContentHandler'} and $method = $callbacks->{'ContentHandler'}->can('skipped_entity') ) {
- my $handler = $callbacks->{'ContentHandler'};
- $self->{Methods}->{'skipped_entity'} = sub { $method->($handler, @_) };
- return $method->($handler, @_);
- }
- elsif (defined $callbacks->{'Handler'} and $method = $callbacks->{'Handler'}->can('skipped_entity') ) {
- my $handler = $callbacks->{'Handler'};
- $self->{Methods}->{'skipped_entity'} = sub { $method->($handler, @_) };
- return $method->($handler, @_);
- }
- elsif (defined $callbacks->{'ContentHandler'}
- and $callbacks->{'ContentHandler'}->can('AUTOLOAD')
- and $callbacks->{'ContentHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '')
- )
- {
- my $res = eval { $callbacks->{'ContentHandler'}->skipped_entity(@_) };
- if ($@) {
- die $@;
- }
- else {
- # I think there's a buggette here...
- # if the first call throws an exception, we don't set it up right.
- # Not fatal, but we might want to address it.
- my $handler = $callbacks->{'ContentHandler'};
- $self->{Methods}->{'skipped_entity'} = sub { $handler->skipped_entity(@_) };
- }
- return $res;
- }
- elsif (defined $callbacks->{'Handler'}
- and $callbacks->{'Handler'}->can('AUTOLOAD')
- and $callbacks->{'Handler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '')
- )
- {
- my $res = eval { $callbacks->{'Handler'}->skipped_entity(@_) };
- if ($@) {
- die $@;
- }
- else {
- # I think there's a buggette here...
- # if the first call throws an exception, we don't set it up right.
- # Not fatal, but we might want to address it.
- my $handler = $callbacks->{'Handler'};
- $self->{Methods}->{'skipped_entity'} = sub { $handler->skipped_entity(@_) };
- }
- return $res;
- }
- else {
- $self->{Methods}->{'skipped_entity'} = sub { };
- }
- }
-
-}
-
-sub end_element {
- my $self = shift;
- if (defined $self->{Methods}->{'end_element'}) {
- $self->{Methods}->{'end_element'}->(@_);
- }
- else {
- my $method;
- my $callbacks;
- if (exists $self->{ParseOptions}) {
- $callbacks = $self->{ParseOptions};
- }
- else {
- $callbacks = $self;
- }
- if (0) { # dummy to make elsif's below compile
- }
- elsif (defined $callbacks->{'ContentHandler'} and $method = $callbacks->{'ContentHandler'}->can('end_element') ) {
- my $handler = $callbacks->{'ContentHandler'};
- $self->{Methods}->{'end_element'} = sub { $method->($handler, @_) };
- return $method->($handler, @_);
- }
- elsif (defined $callbacks->{'DocumentHandler'} and $method = $callbacks->{'DocumentHandler'}->can('end_element') ) {
- my $handler = $callbacks->{'DocumentHandler'};
- $self->{Methods}->{'end_element'} = sub { $method->($handler, @_) };
- return $method->($handler, @_);
- }
- elsif (defined $callbacks->{'Handler'} and $method = $callbacks->{'Handler'}->can('end_element') ) {
- my $handler = $callbacks->{'Handler'};
- $self->{Methods}->{'end_element'} = sub { $method->($handler, @_) };
- return $method->($handler, @_);
- }
- elsif (defined $callbacks->{'ContentHandler'}
- and $callbacks->{'ContentHandler'}->can('AUTOLOAD')
- and $callbacks->{'ContentHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '')
- )
- {
- my $res = eval { $callbacks->{'ContentHandler'}->end_element(@_) };
- if ($@) {
- die $@;
- }
- else {
- # I think there's a buggette here...
- # if the first call throws an exception, we don't set it up right.
- # Not fatal, but we might want to address it.
- my $handler = $callbacks->{'ContentHandler'};
- $self->{Methods}->{'end_element'} = sub { $handler->end_element(@_) };
- }
- return $res;
- }
- elsif (defined $callbacks->{'DocumentHandler'}
- and $callbacks->{'DocumentHandler'}->can('AUTOLOAD')
- and $callbacks->{'DocumentHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '')
- )
- {
- my $res = eval { $callbacks->{'DocumentHandler'}->end_element(@_) };
- if ($@) {
- die $@;
- }
- else {
- # I think there's a buggette here...
- # if the first call throws an exception, we don't set it up right.
- # Not fatal, but we might want to address it.
- my $handler = $callbacks->{'DocumentHandler'};
- $self->{Methods}->{'end_element'} = sub { $handler->end_element(@_) };
- }
- return $res;
- }
- elsif (defined $callbacks->{'Handler'}
- and $callbacks->{'Handler'}->can('AUTOLOAD')
- and $callbacks->{'Handler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '')
- )
- {
- my $res = eval { $callbacks->{'Handler'}->end_element(@_) };
- if ($@) {
- die $@;
- }
- else {
- # I think there's a buggette here...
- # if the first call throws an exception, we don't set it up right.
- # Not fatal, but we might want to address it.
- my $handler = $callbacks->{'Handler'};
- $self->{Methods}->{'end_element'} = sub { $handler->end_element(@_) };
- }
- return $res;
- }
- else {
- $self->{Methods}->{'end_element'} = sub { };
- }
- }
-
-}
-
-sub doctype_decl {
- my $self = shift;
- if (defined $self->{Methods}->{'doctype_decl'}) {
- $self->{Methods}->{'doctype_decl'}->(@_);
- }
- else {
- my $method;
- my $callbacks;
- if (exists $self->{ParseOptions}) {
- $callbacks = $self->{ParseOptions};
- }
- else {
- $callbacks = $self;
- }
- if (0) { # dummy to make elsif's below compile
- }
- elsif (defined $callbacks->{'DTDHandler'} and $method = $callbacks->{'DTDHandler'}->can('doctype_decl') ) {
- my $handler = $callbacks->{'DTDHandler'};
- $self->{Methods}->{'doctype_decl'} = sub { $method->($handler, @_) };
- return $method->($handler, @_);
- }
- elsif (defined $callbacks->{'Handler'} and $method = $callbacks->{'Handler'}->can('doctype_decl') ) {
- my $handler = $callbacks->{'Handler'};
- $self->{Methods}->{'doctype_decl'} = sub { $method->($handler, @_) };
- return $method->($handler, @_);
- }
- elsif (defined $callbacks->{'DTDHandler'}
- and $callbacks->{'DTDHandler'}->can('AUTOLOAD')
- and $callbacks->{'DTDHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '')
- )
- {
- my $res = eval { $callbacks->{'DTDHandler'}->doctype_decl(@_) };
- if ($@) {
- die $@;
- }
- else {
- # I think there's a buggette here...
- # if the first call throws an exception, we don't set it up right.
- # Not fatal, but we might want to address it.
- my $handler = $callbacks->{'DTDHandler'};
- $self->{Methods}->{'doctype_decl'} = sub { $handler->doctype_decl(@_) };
- }
- return $res;
- }
- elsif (defined $callbacks->{'Handler'}
- and $callbacks->{'Handler'}->can('AUTOLOAD')
- and $callbacks->{'Handler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '')
- )
- {
- my $res = eval { $callbacks->{'Handler'}->doctype_decl(@_) };
- if ($@) {
- die $@;
- }
- else {
- # I think there's a buggette here...
- # if the first call throws an exception, we don't set it up right.
- # Not fatal, but we might want to address it.
- my $handler = $callbacks->{'Handler'};
- $self->{Methods}->{'doctype_decl'} = sub { $handler->doctype_decl(@_) };
- }
- return $res;
- }
- else {
- $self->{Methods}->{'doctype_decl'} = sub { };
- }
- }
-
-}
-
-sub comment {
- my $self = shift;
- if (defined $self->{Methods}->{'comment'}) {
- $self->{Methods}->{'comment'}->(@_);
- }
- else {
- my $method;
- my $callbacks;
- if (exists $self->{ParseOptions}) {
- $callbacks = $self->{ParseOptions};
- }
- else {
- $callbacks = $self;
- }
- if (0) { # dummy to make elsif's below compile
- }
- elsif (defined $callbacks->{'DocumentHandler'} and $method = $callbacks->{'DocumentHandler'}->can('comment') ) {
- my $handler = $callbacks->{'DocumentHandler'};
- $self->{Methods}->{'comment'} = sub { $method->($handler, @_) };
- return $method->($handler, @_);
- }
- elsif (defined $callbacks->{'LexicalHandler'} and $method = $callbacks->{'LexicalHandler'}->can('comment') ) {
- my $handler = $callbacks->{'LexicalHandler'};
- $self->{Methods}->{'comment'} = sub { $method->($handler, @_) };
- return $method->($handler, @_);
- }
- elsif (defined $callbacks->{'Handler'} and $method = $callbacks->{'Handler'}->can('comment') ) {
- my $handler = $callbacks->{'Handler'};
- $self->{Methods}->{'comment'} = sub { $method->($handler, @_) };
- return $method->($handler, @_);
- }
- elsif (defined $callbacks->{'DocumentHandler'}
- and $callbacks->{'DocumentHandler'}->can('AUTOLOAD')
- and $callbacks->{'DocumentHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '')
- )
- {
- my $res = eval { $callbacks->{'DocumentHandler'}->comment(@_) };
- if ($@) {
- die $@;
- }
- else {
- # I think there's a buggette here...
- # if the first call throws an exception, we don't set it up right.
- # Not fatal, but we might want to address it.
- my $handler = $callbacks->{'DocumentHandler'};
- $self->{Methods}->{'comment'} = sub { $handler->comment(@_) };
- }
- return $res;
- }
- elsif (defined $callbacks->{'LexicalHandler'}
- and $callbacks->{'LexicalHandler'}->can('AUTOLOAD')
- and $callbacks->{'LexicalHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '')
- )
- {
- my $res = eval { $callbacks->{'LexicalHandler'}->comment(@_) };
- if ($@) {
- die $@;
- }
- else {
- # I think there's a buggette here...
- # if the first call throws an exception, we don't set it up right.
- # Not fatal, but we might want to address it.
- my $handler = $callbacks->{'LexicalHandler'};
- $self->{Methods}->{'comment'} = sub { $handler->comment(@_) };
- }
- return $res;
- }
- elsif (defined $callbacks->{'Handler'}
- and $callbacks->{'Handler'}->can('AUTOLOAD')
- and $callbacks->{'Handler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '')
- )
- {
- my $res = eval { $callbacks->{'Handler'}->comment(@_) };
- if ($@) {
- die $@;
- }
- else {
- # I think there's a buggette here...
- # if the first call throws an exception, we don't set it up right.
- # Not fatal, but we might want to address it.
- my $handler = $callbacks->{'Handler'};
- $self->{Methods}->{'comment'} = sub { $handler->comment(@_) };
- }
- return $res;
- }
- else {
- $self->{Methods}->{'comment'} = sub { };
- }
- }
-
-}
-
-sub end_entity {
- my $self = shift;
- if (defined $self->{Methods}->{'end_entity'}) {
- $self->{Methods}->{'end_entity'}->(@_);
- }
- else {
- my $method;
- my $callbacks;
- if (exists $self->{ParseOptions}) {
- $callbacks = $self->{ParseOptions};
- }
- else {
- $callbacks = $self;
- }
- if (0) { # dummy to make elsif's below compile
- }
- elsif (defined $callbacks->{'LexicalHandler'} and $method = $callbacks->{'LexicalHandler'}->can('end_entity') ) {
- my $handler = $callbacks->{'LexicalHandler'};
- $self->{Methods}->{'end_entity'} = sub { $method->($handler, @_) };
- return $method->($handler, @_);
- }
- elsif (defined $callbacks->{'Handler'} and $method = $callbacks->{'Handler'}->can('end_entity') ) {
- my $handler = $callbacks->{'Handler'};
- $self->{Methods}->{'end_entity'} = sub { $method->($handler, @_) };
- return $method->($handler, @_);
- }
- elsif (defined $callbacks->{'LexicalHandler'}
- and $callbacks->{'LexicalHandler'}->can('AUTOLOAD')
- and $callbacks->{'LexicalHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '')
- )
- {
- my $res = eval { $callbacks->{'LexicalHandler'}->end_entity(@_) };
- if ($@) {
- die $@;
- }
- else {
- # I think there's a buggette here...
- # if the first call throws an exception, we don't set it up right.
- # Not fatal, but we might want to address it.
- my $handler = $callbacks->{'LexicalHandler'};
- $self->{Methods}->{'end_entity'} = sub { $handler->end_entity(@_) };
- }
- return $res;
- }
- elsif (defined $callbacks->{'Handler'}
- and $callbacks->{'Handler'}->can('AUTOLOAD')
- and $callbacks->{'Handler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '')
- )
- {
- my $res = eval { $callbacks->{'Handler'}->end_entity(@_) };
- if ($@) {
- die $@;
- }
- else {
- # I think there's a buggette here...
- # if the first call throws an exception, we don't set it up right.
- # Not fatal, but we might want to address it.
- my $handler = $callbacks->{'Handler'};
- $self->{Methods}->{'end_entity'} = sub { $handler->end_entity(@_) };
- }
- return $res;
- }
- else {
- $self->{Methods}->{'end_entity'} = sub { };
- }
- }
-
-}
-
-sub warning {
- my $self = shift;
- if (defined $self->{Methods}->{'warning'}) {
- $self->{Methods}->{'warning'}->(@_);
- }
- else {
- my $method;
- my $callbacks;
- if (exists $self->{ParseOptions}) {
- $callbacks = $self->{ParseOptions};
- }
- else {
- $callbacks = $self;
- }
- if (0) { # dummy to make elsif's below compile
- }
- elsif (defined $callbacks->{'ErrorHandler'} and $method = $callbacks->{'ErrorHandler'}->can('warning') ) {
- my $handler = $callbacks->{'ErrorHandler'};
- $self->{Methods}->{'warning'} = sub { $method->($handler, @_) };
- return $method->($handler, @_);
- }
- elsif (defined $callbacks->{'Handler'} and $method = $callbacks->{'Handler'}->can('warning') ) {
- my $handler = $callbacks->{'Handler'};
- $self->{Methods}->{'warning'} = sub { $method->($handler, @_) };
- return $method->($handler, @_);
- }
- elsif (defined $callbacks->{'ErrorHandler'}
- and $callbacks->{'ErrorHandler'}->can('AUTOLOAD')
- and $callbacks->{'ErrorHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '')
- )
- {
- my $res = eval { $callbacks->{'ErrorHandler'}->warning(@_) };
- if ($@) {
- die $@;
- }
- else {
- # I think there's a buggette here...
- # if the first call throws an exception, we don't set it up right.
- # Not fatal, but we might want to address it.
- my $handler = $callbacks->{'ErrorHandler'};
- $self->{Methods}->{'warning'} = sub { $handler->warning(@_) };
- }
- return $res;
- }
- elsif (defined $callbacks->{'Handler'}
- and $callbacks->{'Handler'}->can('AUTOLOAD')
- and $callbacks->{'Handler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '')
- )
- {
- my $res = eval { $callbacks->{'Handler'}->warning(@_) };
- if ($@) {
- die $@;
- }
- else {
- # I think there's a buggette here...
- # if the first call throws an exception, we don't set it up right.
- # Not fatal, but we might want to address it.
- my $handler = $callbacks->{'Handler'};
- $self->{Methods}->{'warning'} = sub { $handler->warning(@_) };
- }
- return $res;
- }
- else {
- $self->{Methods}->{'warning'} = sub { };
- }
- }
-
-}
-
-#-------------------------------------------------------------------#
-# Class->new(%options)
-#-------------------------------------------------------------------#
-sub new {
- my $proto = shift;
- my $class = ref($proto) || $proto;
- my $options = ($#_ == 0) ? shift : { @_ };
-
- unless ( defined( $options->{Handler} ) or
- defined( $options->{ContentHandler} ) or
- defined( $options->{DTDHandler} ) or
- defined( $options->{DocumentHandler} ) or
- defined( $options->{LexicalHandler} ) or
- defined( $options->{ErrorHandler} ) or
- defined( $options->{DeclHandler} ) ) {
-
- $options->{Handler} = XML::SAX::Base::NoHandler->new;
- }
-
- my $self = bless $options, $class;
- # turn NS processing on by default
- $self->set_feature('http://xml.org/sax/features/namespaces', 1);
- return $self;
-}
-#-------------------------------------------------------------------#
-
-#-------------------------------------------------------------------#
-# $p->parse(%options)
-#-------------------------------------------------------------------#
-sub parse {
- my $self = shift;
- my $parse_options = $self->get_options(@_);
- local $self->{ParseOptions} = $parse_options;
- if ($self->{Parent}) { # calling parse on a filter for some reason
- return $self->{Parent}->parse($parse_options);
- }
- else {
- my $method;
- if (defined $parse_options->{Source}{CharacterStream} and $method = $self->can('_parse_characterstream')) {
- warn("parse charstream???\n");
- return $method->($self, $parse_options->{Source}{CharacterStream});
- }
- elsif (defined $parse_options->{Source}{ByteStream} and $method = $self->can('_parse_bytestream')) {
- return $method->($self, $parse_options->{Source}{ByteStream});
- }
- elsif (defined $parse_options->{Source}{String} and $method = $self->can('_parse_string')) {
- return $method->($self, $parse_options->{Source}{String});
- }
- elsif (defined $parse_options->{Source}{SystemId} and $method = $self->can('_parse_systemid')) {
- return $method->($self, $parse_options->{Source}{SystemId});
- }
- else {
- die "No _parse_* routine defined on this driver (If it is a filter, remember to set the Parent property. If you call the parse() method, make sure to set a Source. You may want to call parse_uri, parse_string or parse_file instead.) [$self]";
- }
- }
-}
-#-------------------------------------------------------------------#
-
-#-------------------------------------------------------------------#
-# $p->parse_file(%options)
-#-------------------------------------------------------------------#
-sub parse_file {
- my $self = shift;
- my $file = shift;
- return $self->parse_uri($file, @_) if ref(\$file) eq 'SCALAR';
- my $parse_options = $self->get_options(@_);
- $parse_options->{Source}{ByteStream} = $file;
- return $self->parse($parse_options);
-}
-#-------------------------------------------------------------------#
-
-#-------------------------------------------------------------------#
-# $p->parse_uri(%options)
-#-------------------------------------------------------------------#
-sub parse_uri {
- my $self = shift;
- my $file = shift;
- my $parse_options = $self->get_options(@_);
- $parse_options->{Source}{SystemId} = $file;
- return $self->parse($parse_options);
-}
-#-------------------------------------------------------------------#
-
-#-------------------------------------------------------------------#
-# $p->parse_string(%options)
-#-------------------------------------------------------------------#
-sub parse_string {
- my $self = shift;
- my $string = shift;
- my $parse_options = $self->get_options(@_);
- $parse_options->{Source}{String} = $string;
- return $self->parse($parse_options);
-}
-#-------------------------------------------------------------------#
-
-#-------------------------------------------------------------------#
-# get_options
-#-------------------------------------------------------------------#
-sub get_options {
- my $self = shift;
-
- if (@_ == 1) {
- return { %$self, %{$_[0]} };
- } else {
- return { %$self, @_ };
- }
-}
-#-------------------------------------------------------------------#
-
-#-------------------------------------------------------------------#
-# get_features
-#-------------------------------------------------------------------#
-sub get_features {
- return (
- 'http://xml.org/sax/features/external-general-entities' => undef,
- 'http://xml.org/sax/features/external-parameter-entities' => undef,
- 'http://xml.org/sax/features/is-standalone' => undef,
- 'http://xml.org/sax/features/lexical-handler' => undef,
- 'http://xml.org/sax/features/parameter-entities' => undef,
- 'http://xml.org/sax/features/namespaces' => 1,
- 'http://xml.org/sax/features/namespace-prefixes' => 0,
- 'http://xml.org/sax/features/string-interning' => undef,
- 'http://xml.org/sax/features/use-attributes2' => undef,
- 'http://xml.org/sax/features/use-locator2' => undef,
- 'http://xml.org/sax/features/validation' => undef,
-
- 'http://xml.org/sax/properties/dom-node' => undef,
- 'http://xml.org/sax/properties/xml-string' => undef,
- );
-}
-#-------------------------------------------------------------------#
-
-#-------------------------------------------------------------------#
-# get_feature
-#-------------------------------------------------------------------#
-sub get_feature {
- my $self = shift;
- my $feat = shift;
-
- # check %FEATURES to see if it's there, and return it if so
- # throw XML::SAX::Exception::NotRecognized if it's not there
- # throw XML::SAX::Exception::NotSupported if it's there but we
- # don't support it
-
- my %features = $self->get_features();
- if (exists $features{$feat}) {
- my %supported = map { $_ => 1 } $self->supported_features();
- if ($supported{$feat}) {
- return $self->{__PACKAGE__ . "::Features"}{$feat};
- }
- throw XML::SAX::Exception::NotSupported(
- Message => "The feature '$feat' is not supported by " . ref($self),
- Exception => undef,
- );
- }
- throw XML::SAX::Exception::NotRecognized(
- Message => "The feature '$feat' is not recognized by " . ref($self),
- Exception => undef,
- );
-}
-#-------------------------------------------------------------------#
-
-#-------------------------------------------------------------------#
-# set_feature
-#-------------------------------------------------------------------#
-sub set_feature {
- my $self = shift;
- my $feat = shift;
- my $value = shift;
- # check %FEATURES to see if it's there, and set it if so
- # throw XML::SAX::Exception::NotRecognized if it's not there
- # throw XML::SAX::Exception::NotSupported if it's there but we
- # don't support it
-
- my %features = $self->get_features();
- if (exists $features{$feat}) {
- my %supported = map { $_ => 1 } $self->supported_features();
- if ($supported{$feat}) {
- return $self->{__PACKAGE__ . "::Features"}{$feat} = $value;
- }
- throw XML::SAX::Exception::NotSupported(
- Message => "The feature '$feat' is not supported by " . ref($self),
- Exception => undef,
- );
- }
- throw XML::SAX::Exception::NotRecognized(
- Message => "The feature '$feat' is not recognized by " . ref($self),
- Exception => undef,
- );
-}
-#-------------------------------------------------------------------#
-
-#-------------------------------------------------------------------#
-# get_handler and friends
-#-------------------------------------------------------------------#
-sub get_handler {
- my $self = shift;
- my $handler_type = shift;
- $handler_type ||= 'Handler';
- return defined( $self->{$handler_type} ) ? $self->{$handler_type} : undef;
-}
-
-sub get_document_handler {
- my $self = shift;
- return $self->get_handler('DocumentHandler', @_);
-}
-
-sub get_content_handler {
- my $self = shift;
- return $self->get_handler('ContentHandler', @_);
-}
-
-sub get_dtd_handler {
- my $self = shift;
- return $self->get_handler('DTDHandler', @_);
-}
-
-sub get_lexical_handler {
- my $self = shift;
- return $self->get_handler('LexicalHandler', @_);
-}
-
-sub get_decl_handler {
- my $self = shift;
- return $self->get_handler('DeclHandler', @_);
-}
-
-sub get_error_handler {
- my $self = shift;
- return $self->get_handler('ErrorHandler', @_);
-}
-
-sub get_entity_resolver {
- my $self = shift;
- return $self->get_handler('EntityResolver', @_);
-}
-#-------------------------------------------------------------------#
-
-#-------------------------------------------------------------------#
-# set_handler and friends
-#-------------------------------------------------------------------#
-sub set_handler {
- my $self = shift;
- my ($new_handler, $handler_type) = reverse @_;
- $handler_type ||= 'Handler';
- $self->{Methods} = {} if $self->{Methods};
- $self->{$handler_type} = $new_handler;
- $self->{ParseOptions}->{$handler_type} = $new_handler;
- return 1;
-}
-
-sub set_document_handler {
- my $self = shift;
- return $self->set_handler('DocumentHandler', @_);
-}
-
-sub set_content_handler {
- my $self = shift;
- return $self->set_handler('ContentHandler', @_);
-}
-sub set_dtd_handler {
- my $self = shift;
- return $self->set_handler('DTDHandler', @_);
-}
-sub set_lexical_handler {
- my $self = shift;
- return $self->set_handler('LexicalHandler', @_);
-}
-sub set_decl_handler {
- my $self = shift;
- return $self->set_handler('DeclHandler', @_);
-}
-sub set_error_handler {
- my $self = shift;
- return $self->set_handler('ErrorHandler', @_);
-}
-sub set_entity_resolver {
- my $self = shift;
- return $self->set_handler('EntityResolver', @_);
-}
-
-#-------------------------------------------------------------------#
-
-#-------------------------------------------------------------------#
-# supported_features
-#-------------------------------------------------------------------#
-sub supported_features {
- my $self = shift;
- # Only namespaces are required by all parsers
- return (
- 'http://xml.org/sax/features/namespaces',
- );
-}
-#-------------------------------------------------------------------#
-
-sub no_op {
- # this space intentionally blank
-}
-
-
-package XML::SAX::Base::NoHandler;
-
-# we need a fake handler that doesn't implement anything, this
-# simplifies the code a lot (though given the recent changes,
-# it may be better to do without)
-sub new {
- #warn "no handler called\n";
- return bless {};
-}
-
-1;
-
-__END__
-
-=head1 NAME
-
-XML::SAX::Base - Base class SAX Drivers and Filters
-
-=head1 SYNOPSIS
-
- package MyFilter;
- use XML::SAX::Base;
- @ISA = ('XML::SAX::Base');
-
-=head1 DESCRIPTION
-
-This module has a very simple task - to be a base class for PerlSAX
-drivers and filters. It's default behaviour is to pass the input directly
-to the output unchanged. It can be useful to use this module as a base class
-so you don't have to, for example, implement the characters() callback.
-
-The main advantages that it provides are easy dispatching of events the right
-way (ie it takes care for you of checking that the handler has implemented
-that method, or has defined an AUTOLOAD), and the guarantee that filters
-will pass along events that they aren't implementing to handlers downstream
-that might nevertheless be interested in them.
-
-=head1 WRITING SAX DRIVERS AND FILTERS
-
-Writing SAX Filters is tremendously easy: all you need to do is
-inherit from this module, and define the events you want to handle. A
-more detailed explanation can be found at
-http://www.xml.com/pub/a/2001/10/10/sax-filters.html.
-
-Writing Drivers is equally simple. The one thing you need to pay
-attention to is B<NOT> to call events yourself (this applies to Filters
-as well). For instance:
-
- package MyFilter;
- use base qw(XML::SAX::Base);
-
- sub start_element {
- my $self = shift;
- my $data = shift;
- # do something
- $self->{Handler}->start_element($data); # BAD
- }
-
-The above example works well as precisely that: an example. But it has
-several faults: 1) it doesn't test to see whether the handler defines
-start_element. Perhaps it doesn't want to see that event, in which
-case you shouldn't throw it (otherwise it'll die). 2) it doesn't check
-ContentHandler and then Handler (ie it doesn't look to see that the
-user hasn't requested events on a specific handler, and if not on the
-default one), 3) if it did check all that, not only would the code be
-cumbersome (see this module's source to get an idea) but it would also
-probably have to check for a DocumentHandler (in case this were SAX1)
-and for AUTOLOADs potentially defined in all these packages. As you can
-tell, that would be fairly painful. Instead of going through that,
-simply remember to use code similar to the following instead:
-
- package MyFilter;
- use base qw(XML::SAX::Base);
-
- sub start_element {
- my $self = shift;
- my $data = shift;
- # do something to filter
- $self->SUPER::start_element($data); # GOOD (and easy) !
- }
-
-This way, once you've done your job you hand the ball back to
-XML::SAX::Base and it takes care of all those problems for you!
-
-Note that the above example doesn't apply to filters only, drivers
-will benefit from the exact same feature.
-
-=head1 METHODS
-
-A number of methods are defined within this class for the purpose of
-inheritance. Some probably don't need to be overridden (eg parse_file)
-but some clearly should be (eg parse). Options for these methods are
-described in the PerlSAX2 specification available from
-http://cvs.sourceforge.net/cgi-bin/viewcvs.cgi/~checkout~/perl-xml/libxml-perl/doc/sax-2.0.html?rev=HEAD&content-type=text/html.
-
-=over 4
-
-=item * parse
-
-The parse method is the main entry point to parsing documents. Internally
-the parse method will detect what type of "thing" you are parsing, and
-call the appropriate method in your implementation class. Here is the
-mapping table of what is in the Source options (see the Perl SAX 2.0
-specification for the meaning of these values):
-
- Source Contains parse() calls
- =============== =============
- CharacterStream (*) _parse_characterstream($stream, $options)
- ByteStream _parse_bytestream($stream, $options)
- String _parse_string($string, $options)
- SystemId _parse_systemid($string, $options)
-
-However note that these methods may not be sensible if your driver class
-is not for parsing XML. An example might be a DBI driver that generates
-XML/SAX from a database table. If that is the case, you likely want to
-write your own parse() method.
-
-Also note that the Source may contain both a PublicId entry, and an
-Encoding entry. To get at these, examine $options->{Source} as passed
-to your method.
-
-(*) A CharacterStream is a filehandle that does not need any encoding
-translation done on it. This is implemented as a regular filehandle
-and only works under Perl 5.7.2 or higher using PerlIO. To get a single
-character, or number of characters from it, use the perl core read()
-function. To get a single byte from it (or number of bytes), you can
-use sysread(). The encoding of the stream should be in the Encoding
-entry for the Source.
-
-=item * parse_file, parse_uri, parse_string
-
-These are all convenience variations on parse(), and in fact simply
-set up the options before calling it. You probably don't need to
-override these.
-
-=item * get_options
-
-This is a convenience method to get options in SAX2 style, or more
-generically either as hashes or as hashrefs (it returns a hashref).
-You will probably want to use this method in your own implementations
-of parse() and of new().
-
-=item * get_feature, set_feature
-
-These simply get and set features, and throw the
-appropriate exceptions defined in the specification if need be.
-
-If your subclass defines features not defined in this one,
-then you should override these methods in such a way that they check for
-your features first, and then call the base class's methods
-for features not defined by your class. An example would be:
-
- sub get_feature {
- my $self = shift;
- my $feat = shift;
- if (exists $MY_FEATURES{$feat}) {
- # handle the feature in various ways
- }
- else {
- return $self->SUPER::get_feature($feat);
- }
- }
-
-Currently this part is unimplemented.
-
-
-=item * set_handler
-
-This method takes a handler type (Handler, ContentHandler, etc.) and a
-handler object as arguments, and changes the current handler for that
-handler type, while taking care of resetting the internal state that
-needs to be reset. This allows one to change a handler during parse
-without running into problems (changing it on the parser object
-directly will most likely cause trouble).
-
-=item * set_document_handler, set_content_handler, set_dtd_handler, set_lexical_handler, set_decl_handler, set_error_handler, set_entity_resolver
-
-These are just simple wrappers around the former method, and take a
-handler object as their argument. Internally they simply call
-set_handler with the correct arguments.
-
-=item * get_handler
-
-The inverse of set_handler, this method takes a an optional string containing a handler type (DTDHandler,
-ContentHandler, etc. 'Handler' is used if no type is passed). It returns a reference to the object that implements
-that that class, or undef if that handler type is not set for the current driver/filter.
-
-=item * get_document_handler, get_content_handler, get_dtd_handler, get_lexical_handler, get_decl_handler,
-get_error_handler, get_entity_resolver
-
-These are just simple wrappers around the get_handler() method, and take no arguments. Internally
-they simply call get_handler with the correct handler type name.
-
-=back
-
-It would be rather useless to describe all the methods that this
-module implements here. They are all the methods supported in SAX1 and
-SAX2. In case your memory is a little short, here is a list. The
-apparent duplicates are there so that both versions of SAX can be
-supported.
-
-=over 4
-
-=item * start_document
-
-=item * end_document
-
-=item * start_element
-
-=item * start_document
-
-=item * end_document
-
-=item * start_element
-
-=item * end_element
-
-=item * characters
-
-=item * processing_instruction
-
-=item * ignorable_whitespace
-
-=item * set_document_locator
-
-=item * start_prefix_mapping
-
-=item * end_prefix_mapping
-
-=item * skipped_entity
-
-=item * start_cdata
-
-=item * end_cdata
-
-=item * comment
-
-=item * entity_reference
-
-=item * notation_decl
-
-=item * unparsed_entity_decl
-
-=item * element_decl
-
-=item * attlist_decl
-
-=item * doctype_decl
-
-=item * xml_decl
-
-=item * entity_decl
-
-=item * attribute_decl
-
-=item * internal_entity_decl
-
-=item * external_entity_decl
-
-=item * resolve_entity
-
-=item * start_dtd
-
-=item * end_dtd
-
-=item * start_entity
-
-=item * end_entity
-
-=item * warning
-
-=item * error
-
-=item * fatal_error
-
-=back
-
-=head1 TODO
-
- - more tests
- - conform to the "SAX Filters" and "Java and DOM compatibility"
- sections of the SAX2 document.
-
-=head1 AUTHOR
-
-Kip Hampton (khampton@totalcinema.com) did most of the work, after porting
-it from XML::Filter::Base.
-
-Robin Berjon (robin@knowscape.com) pitched in with patches to make it
-usable as a base for drivers as well as filters, along with other patches.
-
-Matt Sergeant (matt@sergeant.org) wrote the original XML::Filter::Base,
-and patched a few things here and there, and imported it into
-the XML::SAX distribution.
-
-=head1 SEE ALSO
-
-L<XML::SAX>
-
-=cut
-
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/XML/SAX/DocumentLocator.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/XML/SAX/DocumentLocator.pm
deleted file mode 100644
index e86d59f8462..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/XML/SAX/DocumentLocator.pm
+++ /dev/null
@@ -1,134 +0,0 @@
-# $Id: DocumentLocator.pm,v 1.3 2005/10/14 20:31:20 matt Exp $
-
-package XML::SAX::DocumentLocator;
-use strict;
-
-sub new {
- my $class = shift;
- my %object;
- tie %object, $class, @_;
-
- return bless \%object, $class;
-}
-
-sub TIEHASH {
- my $class = shift;
- my ($pubmeth, $sysmeth, $linemeth, $colmeth, $encmeth, $xmlvmeth) = @_;
- return bless {
- pubmeth => $pubmeth,
- sysmeth => $sysmeth,
- linemeth => $linemeth,
- colmeth => $colmeth,
- encmeth => $encmeth,
- xmlvmeth => $xmlvmeth,
- }, $class;
-}
-
-sub FETCH {
- my ($self, $key) = @_;
- my $method;
- if ($key eq 'PublicId') {
- $method = $self->{pubmeth};
- }
- elsif ($key eq 'SystemId') {
- $method = $self->{sysmeth};
- }
- elsif ($key eq 'LineNumber') {
- $method = $self->{linemeth};
- }
- elsif ($key eq 'ColumnNumber') {
- $method = $self->{colmeth};
- }
- elsif ($key eq 'Encoding') {
- $method = $self->{encmeth};
- }
- elsif ($key eq 'XMLVersion') {
- $method = $self->{xmlvmeth};
- }
- if ($method) {
- my $value = $method->($key);
- return $value;
- }
- return undef;
-}
-
-sub EXISTS {
- my ($self, $key) = @_;
- if ($key =~ /^(PublicId|SystemId|LineNumber|ColumnNumber|Encoding|XMLVersion)$/) {
- return 1;
- }
- return 0;
-}
-
-sub STORE {
- my ($self, $key, $value) = @_;
-}
-
-sub DELETE {
- my ($self, $key) = @_;
-}
-
-sub CLEAR {
- my ($self) = @_;
-}
-
-sub FIRSTKEY {
- my ($self) = @_;
- # assignment resets.
- $self->{keys} = {
- PublicId => 1,
- SystemId => 1,
- LineNumber => 1,
- ColumnNumber => 1,
- Encoding => 1,
- XMLVersion => 1,
- };
- return each %{$self->{keys}};
-}
-
-sub NEXTKEY {
- my ($self, $lastkey) = @_;
- return each %{$self->{keys}};
-}
-
-1;
-__END__
-
-=head1 NAME
-
-XML::SAX::DocumentLocator - Helper class for document locators
-
-=head1 SYNOPSIS
-
- my $locator = XML::SAX::DocumentLocator->new(
- sub { $object->get_public_id },
- sub { $object->get_system_id },
- sub { $reader->current_line },
- sub { $reader->current_column },
- sub { $reader->get_encoding },
- sub { $reader->get_xml_version },
- );
-
-=head1 DESCRIPTION
-
-This module gives you a tied hash reference that calls the
-specified closures when asked for PublicId, SystemId,
-LineNumber and ColumnNumber.
-
-It is useful for writing SAX Parsers so that you don't have
-to constantly update the line numbers in a hash reference on
-the object you pass to set_document_locator(). See the source
-code for XML::SAX::PurePerl for a usage example.
-
-=head1 API
-
-There is only 1 method: C<new>. Simply pass it a list of
-closures that when called will return the PublicId, the
-SystemId, the LineNumber, the ColumnNumber, the Encoding
-and the XMLVersion respectively.
-
-The closures are passed a single parameter, the key being
-requested. But you're free to ignore that.
-
-=cut
-
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/XML/SAX/Exception.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/XML/SAX/Exception.pm
deleted file mode 100644
index 79910205804..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/XML/SAX/Exception.pm
+++ /dev/null
@@ -1,126 +0,0 @@
-package XML::SAX::Exception;
-
-use strict;
-
-use overload '""' => "stringify",
- 'fallback' => 1;
-
-use vars qw/$StackTrace $VERSION/;
-$VERSION = '1.01';
-use Carp;
-
-$StackTrace = $ENV{XML_DEBUG} || 0;
-
-# Other exception classes:
-
-@XML::SAX::Exception::NotRecognized::ISA = ('XML::SAX::Exception');
-@XML::SAX::Exception::NotSupported::ISA = ('XML::SAX::Exception');
-@XML::SAX::Exception::Parse::ISA = ('XML::SAX::Exception');
-
-
-sub throw {
- my $class = shift;
- if (ref($class)) {
- die $class;
- }
- die $class->new(@_);
-}
-
-sub new {
- my $class = shift;
- my %opts = @_;
- confess "Invalid options: " . join(', ', keys %opts) unless exists $opts{Message};
-
- bless { ($StackTrace ? (StackTrace => stacktrace()) : ()), %opts },
- $class;
-}
-
-sub stringify {
- my $self = shift;
- local $^W;
- my $error;
- if (exists $self->{LineNumber}) {
- $error = $self->{Message} . " [Ln: " . $self->{LineNumber} .
- ", Col: " . $self->{ColumnNumber} . "]";
- }
- else {
- $error = $self->{Message};
- }
- if ($StackTrace) {
- $error .= stackstring($self->{StackTrace});
- }
- $error .= "\n";
- return $error;
-}
-
-sub stacktrace {
- my $i = 2;
- my @fulltrace;
- while (my @trace = caller($i++)) {
- my %hash;
- @hash{qw(Package Filename Line)} = @trace[0..2];
- push @fulltrace, \%hash;
- }
- return \@fulltrace;
-}
-
-sub stackstring {
- my $stacktrace = shift;
- my $string = "\nFrom:\n";
- foreach my $current (@$stacktrace) {
- $string .= $current->{Filename} . " Line: " . $current->{Line} . "\n";
- }
- return $string;
-}
-
-1;
-
-__END__
-
-=head1 NAME
-
-XML::SAX::Exception - Exception classes for XML::SAX
-
-=head1 SYNOPSIS
-
- throw XML::SAX::Exception::NotSupported(
- Message => "The foo feature is not supported",
- );
-
-=head1 DESCRIPTION
-
-This module is the base class for all SAX Exceptions, those defined in
-the spec as well as those that one may create for one's own SAX errors.
-
-There are three subclasses included, corresponding to those of the SAX
-spec:
-
- XML::SAX::Exception::NotSupported
- XML::SAX::Exception::NotRecognized
- XML::SAX::Exception::Parse
-
-Use them wherever you want, and as much as possible when you encounter
-such errors. SAX is meant to use exceptions as much as possible to
-flag problems.
-
-=head1 CREATING NEW EXCEPTION CLASSES
-
-All you need to do to create a new exception class is:
-
- @XML::SAX::Exception::MyException::ISA = ('XML::SAX::Exception')
-
-The given package doesn't need to exist, it'll behave correctly this
-way. If your exception refines an existing exception class, then you
-may also inherit from that instead of from the base class.
-
-=head1 THROWING EXCEPTIONS
-
-This is as simple as exemplified in the SYNOPSIS. In fact, there's
-nothing more to know. All you have to do is:
-
- throw XML::SAX::Exception::MyException( Message => 'Something went wrong' );
-
-and voila, you've thrown an exception which can be caught in an eval block.
-
-=cut
-
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/XML/SAX/Intro.pod b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/XML/SAX/Intro.pod
deleted file mode 100644
index 4a9a405160d..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/XML/SAX/Intro.pod
+++ /dev/null
@@ -1,407 +0,0 @@
-=head1 NAME
-
-XML::SAX::Intro - An Introduction to SAX Parsing with Perl
-
-=head1 Introduction
-
-XML::SAX is a new way to work with XML Parsers in Perl. In this article
-we'll discuss why you should be using SAX, why you should be using
-XML::SAX, and we'll see some of the finer implementation details. The
-text below assumes some familiarity with callback, or push based
-parsing, but if you are unfamiliar with these techniques then a good
-place to start is Kip Hampton's excellent series of articles on XML.com.
-
-=head1 Replacing XML::Parser
-
-The de-facto way of parsing XML under perl is to use Larry Wall and
-Clark Cooper's XML::Parser. This module is a Perl and XS wrapper around
-the expat XML parser library by James Clark. It has been a hugely
-successful project, but suffers from a couple of rather major flaws.
-Firstly it is a proprietary API, designed before the SAX API was
-conceived, which means that it is not easily replaceable by other
-streaming parsers. Secondly it's callbacks are subrefs. This doesn't
-sound like much of an issue, but unfortunately leads to code like:
-
- sub handle_start {
- my ($e, $el, %attrs) = @_;
- if ($el eq 'foo') {
- $e->{inside_foo}++; # BAD! $e is an XML::Parser::Expat object.
- }
- }
-
-As you can see, we're using the $e object to hold our state
-information, which is a bad idea because we don't own that object - we
-didn't create it. It's an internal object of XML::Parser, that happens
-to be a hashref. We could all too easily overwrite XML::Parser internal
-state variables by using this, or Clark could change it to an array ref
-(not that he would, because it would break so much code, but he could).
-
-The only way currently with XML::Parser to safely maintain state is to
-use a closure:
-
- my $state = MyState->new();
- $parser->setHandlers(Start => sub { handle_start($state, @_) });
-
-This closure traps the $state variable, which now gets passed as the
-first parameter to your callback. Unfortunately very few people use
-this technique, as it is not documented in the XML::Parser POD files.
-
-Another reason you might not want to use XML::Parser is because you
-need some feature that it doesn't provide (such as validation), or you
-might need to use a library that doesn't use expat, due to it not being
-installed on your system, or due to having a restrictive ISP. Using SAX
-allows you to work around these restrictions.
-
-=head1 Introducing SAX
-
-SAX stands for the Simple API for XML. And simple it really is.
-Constructing a SAX parser and passing events to handlers is done as
-simply as:
-
- use XML::SAX;
- use MySAXHandler;
-
- my $parser = XML::SAX::ParserFactory->parser(
- Handler => MySAXHandler->new
- );
-
- $parser->parse_uri("foo.xml");
-
-The important concept to grasp here is that SAX uses a factory class
-called XML::SAX::ParserFactory to create a new parser instance. The
-reason for this is so that you can support other underlying
-parser implementations for different feature sets. This is one thing
-that XML::Parser has always sorely lacked.
-
-In the code above we see the parse_uri method used, but we could
-have equally well
-called parse_file, parse_string, or parse(). Please see XML::SAX::Base
-for what these methods take as parameters, but don't be fooled into
-believing parse_file takes a filename. No, it takes a file handle, a
-glob, or a subclass of IO::Handle. Beware.
-
-SAX works very similarly to XML::Parser's default callback method,
-except it has one major difference: rather than setting individual
-callbacks, you create a new class in which to recieve the callbacks.
-Each callback is called as a method call on an instance of that handler
-class. An example will best demonstrate this:
-
- package MySAXHandler;
- use base qw(XML::SAX::Base);
-
- sub start_document {
- my ($self, $doc) = @_;
- # process document start event
- }
-
- sub start_element {
- my ($self, $el) = @_;
- # process element start event
- }
-
-Now, when we instantiate this as above, and parse some XML with this as
-the handler, the methods start_document and start_element will be
-called as method calls, so this would be the equivalent of directly
-calling:
-
- $object->start_element($el);
-
-Notice how this is different to XML::Parser's calling style, which
-calls:
-
- start_element($e, $name, %attribs);
-
-It's the difference between function calling and method calling which
-allows you to subclass SAX handlers which contributes to SAX being a
-powerful solution.
-
-As you can see, unlike XML::Parser, we have to define a new package in
-which to do our processing (there are hacks you can do to make this
-uneccessary, but I'll leave figuring those out to the experts). The
-biggest benefit of this is that you maintain your own state variable
-($self in the above example) thus freeing you of the concerns listed
-above. It is also an improvement in maintainability - you can place the
-code in a separate file if you wish to, and your callback methods are
-always called the same thing, rather than having to choose a suitable
-name for them as you had to with XML::Parser. This is an obvious win.
-
-SAX parsers are also very flexible in how you pass a handler to them.
-You can use a constructor parameter as we saw above, or we can pass the
-handler directly in the call to one of the parse methods:
-
- $parser->parse(Handler => $handler,
- Source => { SystemId => "foo.xml" });
- # or...
- $parser->parse_file($fh, Handler => $handler);
-
-This flexibility allows for one parser to be used in many different
-scenarios throughout your script (though one shouldn't feel pressure to
-use this method, as parser construction is generally not a time
-consuming process).
-
-=head1 Callback Parameters
-
-The only other thing you need to know to understand basic SAX is the
-structure of the parameters passed to each of the callbacks. In
-XML::Parser, all parameters are passed as multiple options to the
-callbacks, so for example the Start callback would be called as
-my_start($e, $name, %attributes), and the PI callback would be called
-as my_processing_instruction($e, $target, $data). In SAX, every
-callback is passed a hash reference, containing entries that define our
-"node". The key callbacks and the structures they receive are:
-
-=head2 start_element
-
-The start_element handler is called whenever a parser sees an opening
-tag. It is passed an element structure consisting of:
-
-=over 4
-
-=item LocalName
-
-The name of the element minus any namespace prefix it may
-have come with in the document.
-
-=item NamespaceURI
-
-The URI of the namespace associated with this element,
-or the empty string for none.
-
-=item Attributes
-
-A set of attributes as described below.
-
-=item Name
-
-The name of the element as it was seen in the document (i.e.
-including any prefix associated with it)
-
-=item Prefix
-
-The prefix used to qualify this element's namespace, or the
-empty string if none.
-
-=back
-
-The B<Attributes> are a hash reference, keyed by what we have called
-"James Clark" notation. This means that the attribute name has been
-expanded to include any associated namespace URI, and put together as
-{ns}name, where "ns" is the expanded namespace URI of the attribute if
-and only if the attribute had a prefix, and "name" is the LocalName of
-the attribute.
-
-The value of each entry in the attributes hash is another hash
-structure consisting of:
-
-=over 4
-
-=item LocalName
-
-The name of the attribute minus any namespace prefix it may have
-come with in the document.
-
-=item NamespaceURI
-
-The URI of the namespace associated with this attribute. If the
-attribute had no prefix, then this consists of just the empty string.
-
-=item Name
-
-The attribute's name as it appeared in the document, including any
-namespace prefix.
-
-=item Prefix
-
-The prefix used to qualify this attribute's namepace, or the
-empty string if none.
-
-=item Value
-
-The value of the attribute.
-
-=back
-
-So a full example, as output by Data::Dumper might be:
-
- ....
-
-=head2 end_element
-
-The end_element handler is called either when a parser sees a closing
-tag, or after start_element has been called for an empty element (do
-note however that a parser may if it is so inclined call characters
-with an empty string when it sees an empty element. There is no simple
-way in SAX to determine if the parser in fact saw an empty element, a
-start and end element with no content..
-
-The end_element handler receives exactly the same structure as
-start_element, minus the Attributes entry. One must note though that it
-should not be a reference to the same data as start_element receives,
-so you may change the values in start_element but this will not affect
-the values later seen by end_element.
-
-=head2 characters
-
-The characters callback may be called in serveral circumstances. The
-most obvious one is when seeing ordinary character data in the markup.
-But it is also called for text in a CDATA section, and is also called
-in other situations. A SAX parser has to make no guarantees whatsoever
-about how many times it may call characters for a stretch of text in an
-XML document - it may call once, or it may call once for every
-character in the text. In order to work around this it is often
-important for the SAX developer to use a bundling technique, where text
-is gathered up and processed in one of the other callbacks. This is not
-always necessary, but it is a worthwhile technique to learn, which we
-will cover in XML::SAX::Advanced (when I get around to writing it).
-
-The characters handler is called with a very simple structure - a hash
-reference consisting of just one entry:
-
-=over 4
-
-=item Data
-
-The text data that was received.
-
-=back
-
-=head2 comment
-
-The comment callback is called for comment text. Unlike with
-C<characters()>, the comment callback *must* be invoked just once for an
-entire comment string. It receives a single simple structure - a hash
-reference containing just one entry:
-
-=over 4
-
-=item Data
-
-The text of the comment.
-
-=back
-
-=head2 processing_instruction
-
-The processing instruction handler is called for all processing
-instructions in the document. Note that these processing instructions
-may appear before the document root element, or after it, or anywhere
-where text and elements would normally appear within the document,
-according to the XML specification.
-
-The handler is passed a structure containing just two entries:
-
-=over 4
-
-=item Target
-
-The target of the processing instrcution
-
-=item Data
-
-The text data in the processing instruction. Can be an empty
-string for a processing instruction that has no data element.
-For example E<lt>?wiggle?E<gt> is a perfectly valid processing instruction.
-
-=back
-
-=head1 Tip of the iceberg
-
-What we have discussed above is really the tip of the SAX iceberg. And
-so far it looks like there's not much of interest to SAX beyond what we
-have seen with XML::Parser. But it does go much further than that, I
-promise.
-
-People who hate Object Oriented code for the sake of it may be thinking
-here that creating a new package just to parse something is a waste
-when they've been parsing things just fine up to now using procedural
-code. But there's reason to all this madness. And that reason is SAX
-Filters.
-
-As you saw right at the very start, to let the parser know about our
-class, we pass it an instance of our class as the Handler to the
-parser. But now imagine what would happen if our class could also take
-a Handler option, and simply do some processing and pass on our data
-further down the line? That in a nutshell is how SAX filters work. It's
-Unix pipes for the 21st century!
-
-There are two downsides to this. Number 1 - writing SAX filters can be
-tricky. If you look into the future and read the advanced tutorial I'm
-writing, you'll see that Handler can come in several shapes and sizes.
-So making sure your filter does the right thing can be tricky.
-Secondly, constructing complex filter chains can be difficult, and
-simple thinking tells us that we only get one pass at our document,
-when often we'll need more than that.
-
-Luckily though, those downsides have been fixed by the release of two
-very cool modules. What's even better is that I didn't write either of
-them!
-
-The first module is XML::SAX::Base. This is a VITAL SAX module that
-acts as a base class for all SAX parsers and filters. It provides an
-abstraction away from calling the handler methods, that makes sure your
-filter or parser does the right thing, and it does it FAST. So, if you
-ever need to write a SAX filter, which if you're processing XML -> XML,
-or XML -> HTML, then you probably do, then you need to be writing it as
-a subclass of XML::SAX::Base. Really - this is advice not to ignore
-lightly. I will not go into the details of writing a SAX filter here.
-Kip Hampton, the author of XML::SAX::Base has covered this nicely in
-his article on XML.com here <URI>.
-
-To construct SAX pipelines, Barrie Slaymaker, a long time Perl hacker
-who's modules you will probably have heard of or used, wrote a very
-clever module called XML::SAX::Machines. This combines some really
-clever SAX filter-type modules, with a construction toolkit for filters
-that makes building pipelines easy. But before we see how it makes
-things easy, first lets see how tricky it looks to build complex SAX
-filter pipelines.
-
- use XML::SAX::ParserFactory;
- use XML::Filter::Filter1;
- use XML::Filter::Filter2;
- use XML::SAX::Writer;
-
- my $output_string;
- my $writer = XML::SAX::Writer->new(Output => \$output_string);
- my $filter2 = XML::SAX::Filter2->new(Handler => $writer);
- my $filter1 = XML::SAX::Filter1->new(Handler => $filter2);
- my $parser = XML::SAX::ParserFactory->parser(Handler => $filter1);
-
- $parser->parse_uri("foo.xml");
-
-This is a lot easier with XML::SAX::Machines:
-
- use XML::SAX::Machines qw(Pipeline);
-
- my $output_string;
- my $parser = Pipeline(
- XML::SAX::Filter1 => XML::SAX::Filter2 => \$output_string
- );
-
- $parser->parse_uri("foo.xml");
-
-One of the main benefits of XML::SAX::Machines is that the pipelines
-are constructed in natural order, rather than the reverse order we saw
-with manual pipeline construction. XML::SAX::Machines takes care of all
-the internals of pipe construction, providing you at the end with just
-a parser you can use (and you can re-use the same parser as many times
-as you need to).
-
-Just a final tip. If you ever get stuck and are confused about what is
-being passed from one SAX filter or parser to the next, then
-Devel::TraceSAX will come to your rescue. This perl debugger plugin
-will allow you to dump the SAX stream of events as it goes by. Usage is
-really very simple just call your perl script that uses SAX as follows:
-
- $ perl -d:TraceSAX <scriptname>
-
-And preferably pipe the output to a pager of some sort, such as more or
-less. The output is extremely verbose, but should help clear some
-issues up.
-
-=head1 AUTHOR
-
-Matt Sergeant, matt@sergeant.org
-
-$Id: Intro.pod,v 1.3 2002/04/30 07:16:00 matt Exp $
-
-=cut
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/XML/SAX/ParserFactory.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/XML/SAX/ParserFactory.pm
deleted file mode 100644
index a52ddf59c25..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/XML/SAX/ParserFactory.pm
+++ /dev/null
@@ -1,232 +0,0 @@
-# $Id: ParserFactory.pm,v 1.13 2002/11/19 18:25:47 matt Exp $
-
-package XML::SAX::ParserFactory;
-
-use strict;
-use vars qw($VERSION);
-
-$VERSION = '1.01';
-
-use Symbol qw(gensym);
-use XML::SAX;
-use XML::SAX::Exception;
-
-sub new {
- my $class = shift;
- my %params = @_; # TODO : Fix this in spec.
- my $self = bless \%params, $class;
- $self->{KnownParsers} = XML::SAX->parsers();
- return $self;
-}
-
-sub parser {
- my $self = shift;
- my @parser_params = @_;
- if (!ref($self)) {
- $self = $self->new();
- }
-
- my $parser_class = $self->_parser_class();
-
- my $version = '';
- if ($parser_class =~ s/\s*\(([\d\.]+)\)\s*$//) {
- $version = " $1";
- }
-
- {
- no strict 'refs';
- if (!keys %{"${parser_class}::"}) {
- eval "use $parser_class $version;";
- }
- }
-
- return $parser_class->new(@parser_params);
-}
-
-sub require_feature {
- my $self = shift;
- my ($feature) = @_;
- $self->{RequiredFeatures}{$feature}++;
- return $self;
-}
-
-sub _parser_class {
- my $self = shift;
-
- # First try ParserPackage
- if ($XML::SAX::ParserPackage) {
- return $XML::SAX::ParserPackage;
- }
-
- # Now check if required/preferred is there
- if ($self->{RequiredFeatures}) {
- my %required = %{$self->{RequiredFeatures}};
- # note - we never go onto the next try (ParserDetails.ini),
- # because if we can't provide the requested feature
- # we need to throw an exception.
- PARSER:
- foreach my $parser (reverse @{$self->{KnownParsers}}) {
- foreach my $feature (keys %required) {
- if (!exists $parser->{Features}{$feature}) {
- next PARSER;
- }
- }
- # got here - all features must exist!
- return $parser->{Name};
- }
- # TODO : should this be NotSupported() ?
- throw XML::SAX::Exception (
- Message => "Unable to provide required features",
- );
- }
-
- # Next try SAX.ini
- for my $dir (@INC) {
- my $fh = gensym();
- if (open($fh, "$dir/SAX.ini")) {
- my $param_list = XML::SAX->_parse_ini_file($fh);
- my $params = $param_list->[0]->{Features};
- if ($params->{ParserPackage}) {
- return $params->{ParserPackage};
- }
- else {
- # we have required features (or nothing?)
- PARSER:
- foreach my $parser (reverse @{$self->{KnownParsers}}) {
- foreach my $feature (keys %$params) {
- if (!exists $parser->{Features}{$feature}) {
- next PARSER;
- }
- }
- return $parser->{Name};
- }
- XML::SAX->do_warn("Unable to provide SAX.ini required features. Using fallback\n");
- }
- last; # stop after first INI found
- }
- }
-
- if (@{$self->{KnownParsers}}) {
- return $self->{KnownParsers}[-1]{Name};
- }
- else {
- return "XML::SAX::PurePerl"; # backup plan!
- }
-}
-
-1;
-__END__
-
-=head1 NAME
-
-XML::SAX::ParserFactory - Obtain a SAX parser
-
-=head1 SYNOPSIS
-
- use XML::SAX::ParserFactory;
- use XML::SAX::XYZHandler;
- my $handler = XML::SAX::XYZHandler->new();
- my $p = XML::SAX::ParserFactory->parser(Handler => $handler);
- $p->parse_uri("foo.xml");
- # or $p->parse_string("<foo/>") or $p->parse_file($fh);
-
-=head1 DESCRIPTION
-
-XML::SAX::ParserFactory is a factory class for providing an application
-with a Perl SAX2 XML parser. It is akin to DBI - a front end for other
-parser classes. Each new SAX2 parser installed will register itself
-with XML::SAX, and then it will become available to all applications
-that use XML::SAX::ParserFactory to obtain a SAX parser.
-
-Unlike DBI however, XML/SAX parsers almost all work alike (especially
-if they subclass XML::SAX::Base, as they should), so rather than
-specifying the parser you want in the call to C<parser()>, XML::SAX
-has several ways to automatically choose which parser to use:
-
-=over 4
-
-=item * $XML::SAX::ParserPackage
-
-If this package variable is set, then this package is C<require()>d
-and an instance of this package is returned by calling the C<new()>
-class method in that package. If it cannot be loaded or there is
-an error, an exception will be thrown. The variable can also contain
-a version number:
-
- $XML::SAX::ParserPackage = "XML::SAX::Expat (0.72)";
-
-And the number will be treated as a minimum version number.
-
-=item * Required features
-
-It is possible to require features from the parsers. For example, you
-may wish for a parser that supports validation via a DTD. To do that,
-use the following code:
-
- use XML::SAX::ParserFactory;
- my $factory = XML::SAX::ParserFactory->new();
- $factory->require_feature('http://xml.org/sax/features/validation');
- my $parser = $factory->parser(...);
-
-Alternatively, specify the required features in the call to the
-ParserFactory constructor:
-
- my $factory = XML::SAX::ParserFactory->new(
- RequiredFeatures => {
- 'http://xml.org/sax/features/validation' => 1,
- }
- );
-
-If the features you have asked for are unavailable (for example the
-user might not have a validating parser installed), then an
-exception will be thrown.
-
-The list of known parsers is searched in reverse order, so it will
-always return the last installed parser that supports all of your
-requested features (Note: this is subject to change if someone
-comes up with a better way of making this work).
-
-=item * SAX.ini
-
-ParserFactory will search @INC for a file called SAX.ini, which
-is in a simple format:
-
- # a comment looks like this,
- ; or like this, and are stripped anywhere in the file
- key = value # SAX.in contains key/value pairs.
-
-All whitespace is non-significant.
-
-This file can contain either a line:
-
- ParserPackage = MyParserModule (1.02)
-
-Where MyParserModule is the module to load and use for the parser,
-and the number in brackets is a minimum version to load.
-
-Or you can list required features:
-
- http://xml.org/sax/features/validation = 1
-
-And each feature with a true value will be required.
-
-=item * Fallback
-
-If none of the above works, the last parser installed on the user's
-system will be used. The XML::SAX package ships with a pure perl
-XML parser, XML::SAX::PurePerl, so that there will always be a
-fallback parser.
-
-=back
-
-=head1 AUTHOR
-
-Matt Sergeant, matt@sergeant.org
-
-=head1 LICENSE
-
-This is free software, you may use it and distribute it under the same
-terms as Perl itself.
-
-=cut
-
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/XML/SAX/PurePerl.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/XML/SAX/PurePerl.pm
deleted file mode 100644
index dfd34f4eb95..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/XML/SAX/PurePerl.pm
+++ /dev/null
@@ -1,746 +0,0 @@
-# $Id: PurePerl.pm,v 1.23 2007/06/27 09:08:00 grant Exp $
-
-package XML::SAX::PurePerl;
-
-use strict;
-use vars qw/$VERSION/;
-
-$VERSION = '0.92';
-
-use XML::SAX::PurePerl::Productions qw($Any $CharMinusDash $SingleChar);
-use XML::SAX::PurePerl::Reader;
-use XML::SAX::PurePerl::EncodingDetect ();
-use XML::SAX::Exception;
-use XML::SAX::PurePerl::DocType ();
-use XML::SAX::PurePerl::DTDDecls ();
-use XML::SAX::PurePerl::XMLDecl ();
-use XML::SAX::DocumentLocator ();
-use XML::SAX::Base ();
-use XML::SAX qw(Namespaces);
-use XML::NamespaceSupport ();
-use IO::File;
-
-if ($] < 5.006) {
- require XML::SAX::PurePerl::NoUnicodeExt;
-}
-else {
- require XML::SAX::PurePerl::UnicodeExt;
-}
-
-use vars qw(@ISA);
-@ISA = ('XML::SAX::Base');
-
-my %int_ents = (
- amp => '&',
- lt => '<',
- gt => '>',
- quot => '"',
- apos => "'",
- );
-
-my $xmlns_ns = "http://www.w3.org/2000/xmlns/";
-my $xml_ns = "http://www.w3.org/XML/1998/namespace";
-
-use Carp;
-sub _parse_characterstream {
- my $self = shift;
- my ($fh) = @_;
- confess("CharacterStream is not yet correctly implemented");
- my $reader = XML::SAX::PurePerl::Reader::Stream->new($fh);
- return $self->_parse($reader);
-}
-
-sub _parse_bytestream {
- my $self = shift;
- my ($fh) = @_;
- my $reader = XML::SAX::PurePerl::Reader::Stream->new($fh);
- return $self->_parse($reader);
-}
-
-sub _parse_string {
- my $self = shift;
- my ($str) = @_;
- my $reader = XML::SAX::PurePerl::Reader::String->new($str);
- return $self->_parse($reader);
-}
-
-sub _parse_systemid {
- my $self = shift;
- my ($uri) = @_;
- my $reader = XML::SAX::PurePerl::Reader::URI->new($uri);
- return $self->_parse($reader);
-}
-
-sub _parse {
- my ($self, $reader) = @_;
-
- $reader->public_id($self->{ParseOptions}{Source}{PublicId});
- $reader->system_id($self->{ParseOptions}{Source}{SystemId});
-
- $self->{NSHelper} = XML::NamespaceSupport->new({xmlns => 1});
-
- $self->set_document_locator(
- XML::SAX::DocumentLocator->new(
- sub { $reader->public_id },
- sub { $reader->system_id },
- sub { $reader->line },
- sub { $reader->column },
- sub { $reader->get_encoding },
- sub { $reader->get_xml_version },
- ),
- );
-
- $self->start_document({});
-
- if (defined $self->{ParseOptions}{Source}{Encoding}) {
- $reader->set_encoding($self->{ParseOptions}{Source}{Encoding});
- }
- else {
- $self->encoding_detect($reader);
- }
-
- # parse a document
- $self->document($reader);
-
- return $self->end_document({});
-}
-
-sub parser_error {
- my $self = shift;
- my ($error, $reader) = @_;
-
-# warn("parser error: $error from ", $reader->line, " : ", $reader->column, "\n");
- my $exception = XML::SAX::Exception::Parse->new(
- Message => $error,
- ColumnNumber => $reader->column,
- LineNumber => $reader->line,
- PublicId => $reader->public_id,
- SystemId => $reader->system_id,
- );
-
- $self->fatal_error($exception);
- $exception->throw;
-}
-
-sub document {
- my ($self, $reader) = @_;
-
- # document ::= prolog element Misc*
-
- $self->prolog($reader);
- $self->element($reader) ||
- $self->parser_error("Document requires an element", $reader);
-
- while(length($reader->data)) {
- $self->Misc($reader) ||
- $self->parser_error("Only Comments, PIs and whitespace allowed at end of document", $reader);
- }
-}
-
-sub prolog {
- my ($self, $reader) = @_;
-
- $self->XMLDecl($reader);
-
- # consume all misc bits
- 1 while($self->Misc($reader));
-
- if ($self->doctypedecl($reader)) {
- while (length($reader->data)) {
- $self->Misc($reader) || last;
- }
- }
-}
-
-sub element {
- my ($self, $reader) = @_;
-
- return 0 unless $reader->match('<');
-
- my $name = $self->Name($reader) || $self->parser_error("Invalid element name", $reader);
-
- my %attribs;
-
- while( my ($k, $v) = $self->Attribute($reader) ) {
- $attribs{$k} = $v;
- }
-
- my $have_namespaces = $self->get_feature(Namespaces);
-
- # Namespace processing
- $self->{NSHelper}->push_context;
- my @new_ns;
-# my %attrs = @attribs;
-# while (my ($k,$v) = each %attrs) {
- if ($have_namespaces) {
- while ( my ($k, $v) = each %attribs ) {
- if ($k =~ m/^xmlns(:(.*))?$/) {
- my $prefix = $2 || '';
- $self->{NSHelper}->declare_prefix($prefix, $v);
- my $ns =
- {
- Prefix => $prefix,
- NamespaceURI => $v,
- };
- push @new_ns, $ns;
- $self->SUPER::start_prefix_mapping($ns);
- }
- }
- }
-
- # Create element object and fire event
- my %attrib_hash;
- while (my ($name, $value) = each %attribs ) {
- # TODO normalise value here
- my ($ns, $prefix, $lname);
- if ($have_namespaces) {
- ($ns, $prefix, $lname) = $self->{NSHelper}->process_attribute_name($name);
- }
- $ns ||= ''; $prefix ||= ''; $lname ||= '';
- $attrib_hash{"{$ns}$lname"} = {
- Name => $name,
- LocalName => $lname,
- Prefix => $prefix,
- NamespaceURI => $ns,
- Value => $value,
- };
- }
-
- %attribs = (); # lose the memory since we recurse deep
-
- my ($ns, $prefix, $lname);
- if ($self->get_feature(Namespaces)) {
- ($ns, $prefix, $lname) = $self->{NSHelper}->process_element_name($name);
- }
- else {
- $lname = $name;
- }
- $ns ||= ''; $prefix ||= ''; $lname ||= '';
-
- # Process remainder of start_element
- $self->skip_whitespace($reader);
- my $have_content;
- my $data = $reader->data(2);
- if ($data =~ /^\/>/) {
- $reader->move_along(2);
- }
- else {
- $data =~ /^>/ or $self->parser_error("No close element tag", $reader);
- $reader->move_along(1);
- $have_content++;
- }
-
- my $el =
- {
- Name => $name,
- LocalName => $lname,
- Prefix => $prefix,
- NamespaceURI => $ns,
- Attributes => \%attrib_hash,
- };
- $self->start_element($el);
-
- # warn("($name\n");
-
- if ($have_content) {
- $self->content($reader);
-
- my $data = $reader->data(2);
- $data =~ /^<\// or $self->parser_error("No close tag marker", $reader);
- $reader->move_along(2);
- my $end_name = $self->Name($reader);
- $end_name eq $name || $self->parser_error("End tag mismatch ($end_name != $name)", $reader);
- $self->skip_whitespace($reader);
- $reader->match('>') or $self->parser_error("No close '>' on end tag", $reader);
- }
-
- my %end_el = %$el;
- delete $end_el{Attributes};
- $self->end_element(\%end_el);
-
- for my $ns (@new_ns) {
- $self->end_prefix_mapping($ns);
- }
- $self->{NSHelper}->pop_context;
-
- return 1;
-}
-
-sub content {
- my ($self, $reader) = @_;
-
- while (1) {
- $self->CharData($reader);
-
- my $data = $reader->data(2);
-
- if ($data =~ /^<\//) {
- return 1;
- }
- elsif ($data =~ /^&/) {
- $self->Reference($reader) or $self->parser_error("bare & not allowed in content", $reader);
- next;
- }
- elsif ($data =~ /^<!/) {
- ($self->CDSect($reader)
- or
- $self->Comment($reader))
- and next;
- }
- elsif ($data =~ /^<\?/) {
- $self->PI($reader) and next;
- }
- elsif ($data =~ /^</) {
- $self->element($reader) and next;
- }
- last;
- }
-
- return 1;
-}
-
-sub CDSect {
- my ($self, $reader) = @_;
-
- my $data = $reader->data(9);
- return 0 unless $data =~ /^<!\[CDATA\[/;
- $reader->move_along(9);
-
- $self->start_cdata({});
-
- $data = $reader->data;
- while (1) {
- $self->parser_error("EOF looking for CDATA section end", $reader)
- unless length($data);
-
- if ($data =~ /^(.*?)\]\]>/s) {
- my $chars = $1;
- $reader->move_along(length($chars) + 3);
- $self->characters({Data => $chars});
- last;
- }
- else {
- $self->characters({Data => $data});
- $reader->move_along(length($data));
- $data = $reader->data;
- }
- }
- $self->end_cdata({});
- return 1;
-}
-
-sub CharData {
- my ($self, $reader) = @_;
-
- my $data = $reader->data;
-
- while (1) {
- return unless length($data);
-
- if ($data =~ /^([^<&]*)[<&]/s) {
- my $chars = $1;
- $self->parser_error("String ']]>' not allowed in character data", $reader)
- if $chars =~ /\]\]>/;
- $reader->move_along(length($chars));
- $self->characters({Data => $chars}) if length($chars);
- last;
- }
- else {
- $self->characters({Data => $data});
- $reader->move_along(length($data));
- $data = $reader->data;
- }
- }
-}
-
-sub Misc {
- my ($self, $reader) = @_;
- if ($self->Comment($reader)) {
- return 1;
- }
- elsif ($self->PI($reader)) {
- return 1;
- }
- elsif ($self->skip_whitespace($reader)) {
- return 1;
- }
-
- return 0;
-}
-
-sub Reference {
- my ($self, $reader) = @_;
-
- return 0 unless $reader->match('&');
-
- my $data = $reader->data;
-
- if ($data =~ /^#x([0-9a-fA-F]+);/) {
- my $ref = $1;
- $reader->move_along(length($ref) + 3);
- my $char = chr_ref(hex($ref));
- $self->parser_error("Character reference &#$ref; refers to an illegal XML character ($char)", $reader)
- unless $char =~ /$SingleChar/o;
- $self->characters({ Data => $char });
- return 1;
- }
- elsif ($data =~ /^#([0-9]+);/) {
- my $ref = $1;
- $reader->move_along(length($ref) + 2);
- my $char = chr_ref($ref);
- $self->parser_error("Character reference &#$ref; refers to an illegal XML character ($char)", $reader)
- unless $char =~ /$SingleChar/o;
- $self->characters({ Data => $char });
- return 1;
- }
- else {
- # EntityRef
- my $name = $self->Name($reader)
- || $self->parser_error("Invalid name in entity", $reader);
- $reader->match(';') or $self->parser_error("No semi-colon found after entity name", $reader);
-
- # warn("got entity: \&$name;\n");
-
- # expand it
- if ($self->_is_entity($name)) {
-
- if ($self->_is_external($name)) {
- my $value = $self->_get_entity($name);
- my $ent_reader = XML::SAX::PurePerl::Reader::URI->new($value);
- $self->encoding_detect($ent_reader);
- $self->extParsedEnt($ent_reader);
- }
- else {
- my $value = $self->_stringify_entity($name);
- my $ent_reader = XML::SAX::PurePerl::Reader::String->new($value);
- $self->content($ent_reader);
- }
- return 1;
- }
- elsif ($name =~ /^(?:amp|gt|lt|quot|apos)$/) {
- $self->characters({ Data => $int_ents{$name} });
- return 1;
- }
- else {
- $self->parser_error("Undeclared entity", $reader);
- }
- }
-}
-
-sub AttReference {
- my ($self, $name, $reader) = @_;
- if ($name =~ /^#x([0-9a-fA-F]+)$/) {
- my $chr = chr_ref(hex($1));
- $chr =~ /$SingleChar/o or $self->parser_error("Character reference '&$name;' refers to an illegal XML character", $reader);
- return $chr;
- }
- elsif ($name =~ /^#([0-9]+)$/) {
- my $chr = chr_ref($1);
- $chr =~ /$SingleChar/o or $self->parser_error("Character reference '&$name;' refers to an illegal XML character", $reader);
- return $chr;
- }
- else {
- if ($self->_is_entity($name)) {
- if ($self->_is_external($name)) {
- $self->parser_error("No external entity references allowed in attribute values", $reader);
- }
- else {
- my $value = $self->_stringify_entity($name);
- return $value;
- }
- }
- elsif ($name =~ /^(?:amp|lt|gt|quot|apos)$/) {
- return $int_ents{$name};
- }
- else {
- $self->parser_error("Undeclared entity '$name'", $reader);
- }
- }
-}
-
-sub extParsedEnt {
- my ($self, $reader) = @_;
-
- $self->TextDecl($reader);
- $self->content($reader);
-}
-
-sub _is_external {
- my ($self, $name) = @_;
-# TODO: Fix this to use $reader to store the entities perhaps.
- if ($self->{ParseOptions}{external_entities}{$name}) {
- return 1;
- }
- return ;
-}
-
-sub _is_entity {
- my ($self, $name) = @_;
-# TODO: ditto above
- if (exists $self->{ParseOptions}{entities}{$name}) {
- return 1;
- }
- return 0;
-}
-
-sub _stringify_entity {
- my ($self, $name) = @_;
-# TODO: ditto above
- if (exists $self->{ParseOptions}{expanded_entity}{$name}) {
- return $self->{ParseOptions}{expanded_entity}{$name};
- }
- # expand
- my $reader = XML::SAX::PurePerl::Reader::URI->new($self->{ParseOptions}{entities}{$name});
- my $ent = '';
- while(1) {
- my $data = $reader->data;
- $ent .= $data;
- $reader->move_along(length($data)) or last;
- }
- return $self->{ParseOptions}{expanded_entity}{$name} = $ent;
-}
-
-sub _get_entity {
- my ($self, $name) = @_;
-# TODO: ditto above
- return $self->{ParseOptions}{entities}{$name};
-}
-
-sub skip_whitespace {
- my ($self, $reader) = @_;
-
- my $data = $reader->data;
-
- my $found = 0;
- while ($data =~ s/^([\x20\x0A\x0D\x09]*)//) {
- last unless length($1);
- $found++;
- $reader->move_along(length($1));
- $data = $reader->data;
- }
-
- return $found;
-}
-
-sub Attribute {
- my ($self, $reader) = @_;
-
- $self->skip_whitespace($reader) || return;
-
- my $data = $reader->data(2);
- return if $data =~ /^\/?>/;
-
- if (my $name = $self->Name($reader)) {
- $self->skip_whitespace($reader);
- $reader->match('=') or $self->parser_error("No '=' in Attribute", $reader);
- $self->skip_whitespace($reader);
- my $value = $self->AttValue($reader);
-
- if (!$self->cdata_attrib($name)) {
- $value =~ s/^\x20*//; # discard leading spaces
- $value =~ s/\x20*$//; # discard trailing spaces
- $value =~ s/ {1,}/ /g; # all >1 space to single space
- }
-
- return $name, $value;
- }
-
- return;
-}
-
-sub cdata_attrib {
- # TODO implement this!
- return 1;
-}
-
-sub AttValue {
- my ($self, $reader) = @_;
-
- my $quote = $self->quote($reader);
-
- my $value = '';
-
- while (1) {
- my $data = $reader->data;
- $self->parser_error("EOF found while looking for the end of attribute value", $reader)
- unless length($data);
- if ($data =~ /^([^$quote]*)$quote/) {
- $reader->move_along(length($1) + 1);
- $value .= $1;
- last;
- }
- else {
- $value .= $data;
- $reader->move_along(length($data));
- }
- }
-
- if ($value =~ /</) {
- $self->parser_error("< character not allowed in attribute values", $reader);
- }
-
- $value =~ s/[\x09\x0A\x0D]/\x20/g;
- $value =~ s/&(#(x[0-9a-fA-F]+)|([0-9]+)|\w+);/$self->AttReference($1, $reader)/geo;
-
- return $value;
-}
-
-sub Comment {
- my ($self, $reader) = @_;
-
- my $data = $reader->data(4);
- if ($data =~ /^<!--/) {
- $reader->move_along(4);
- my $comment_str = '';
- while (1) {
- my $data = $reader->data;
- $self->parser_error("End of data seen while looking for close comment marker", $reader)
- unless length($data);
- if ($data =~ /^(.*?)-->/s) {
- $comment_str .= $1;
- $self->parser_error("Invalid comment (dash)", $reader) if $comment_str =~ /-$/;
- $reader->move_along(length($1) + 3);
- last;
- }
- else {
- $comment_str .= $data;
- $reader->move_along(length($data));
- }
- }
-
- $self->comment({ Data => $comment_str });
-
- return 1;
- }
- return 0;
-}
-
-sub PI {
- my ($self, $reader) = @_;
-
- my $data = $reader->data(2);
-
- if ($data =~ /^<\?/) {
- $reader->move_along(2);
- my ($target);
- $target = $self->Name($reader) ||
- $self->parser_error("PI has no target", $reader);
-
- my $pi_data = '';
- if ($self->skip_whitespace($reader)) {
- while (1) {
- my $data = $reader->data;
- $self->parser_error("End of data seen while looking for close PI marker", $reader)
- unless length($data);
- if ($data =~ /^(.*?)\?>/s) {
- $pi_data .= $1;
- $reader->move_along(length($1) + 2);
- last;
- }
- else {
- $pi_data .= $data;
- $reader->move_along(length($data));
- }
- }
- }
- else {
- my $data = $reader->data(2);
- $data =~ /^\?>/ or $self->parser_error("PI closing sequence not found", $reader);
- $reader->move_along(2);
- }
-
- $self->processing_instruction({ Target => $target, Data => $pi_data });
-
- return 1;
- }
- return 0;
-}
-
-sub Name {
- my ($self, $reader) = @_;
-
- my $name = '';
- while(1) {
- my $data = $reader->data;
- return unless length($data);
- $data =~ /^([^\s>\/&\?;=<\)\(\[\],\%\#\!\*]*)/ or return;
- $name .= $1;
- my $len = length($1);
- $reader->move_along($len);
- last if ($len != length($data));
- }
-
- return unless length($name);
-
- $name =~ /$NameChar/o or $self->parser_error("Name <$name> does not match NameChar production", $reader);
-
- return $name;
-}
-
-sub quote {
- my ($self, $reader) = @_;
-
- my $data = $reader->data;
-
- $data =~ /^(['"])/ or $self->parser_error("Invalid quote token", $reader);
- $reader->move_along(1);
- return $1;
-}
-
-1;
-__END__
-
-=head1 NAME
-
-XML::SAX::PurePerl - Pure Perl XML Parser with SAX2 interface
-
-=head1 SYNOPSIS
-
- use XML::Handler::Foo;
- use XML::SAX::PurePerl;
- my $handler = XML::Handler::Foo->new();
- my $parser = XML::SAX::PurePerl->new(Handler => $handler);
- $parser->parse_uri("myfile.xml");
-
-=head1 DESCRIPTION
-
-This module implements an XML parser in pure perl. It is written around the
-upcoming perl 5.8's unicode support and support for multiple document
-encodings (using the PerlIO layer), however it has been ported to work with
-ASCII/UTF8 documents under lower perl versions.
-
-The SAX2 API is described in detail at http://sourceforge.net/projects/perl-xml/, in
-the CVS archive, under libxml-perl/docs. Hopefully those documents will be in a
-better location soon.
-
-Please refer to the SAX2 documentation for how to use this module - it is merely a
-front end to SAX2, and implements nothing that is not in that spec (or at least tries
-not to - please email me if you find errors in this implementation).
-
-=head1 BUGS
-
-XML::SAX::PurePerl is B<slow>. Very slow. I suggest you use something else
-in fact. However it is great as a fallback parser for XML::SAX, where the
-user might not be able to install an XS based parser or C library.
-
-Currently lots, probably. At the moment the weakest area is parsing DOCTYPE declarations,
-though the code is in place to start doing this. Also parsing parameter entity
-references is causing me much confusion, since it's not exactly what I would call
-trivial, or well documented in the XML grammar. XML documents with internal subsets
-are likely to fail.
-
-I am however trying to work towards full conformance using the Oasis test suite.
-
-=head1 AUTHOR
-
-Matt Sergeant, matt@sergeant.org. Copyright 2001.
-
-Please report all bugs to the Perl-XML mailing list at perl-xml@listserv.activestate.com.
-
-=head1 LICENSE
-
-This is free software. You may use it or redistribute it under the same terms as
-Perl 5.7.2 itself.
-
-=cut
-
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/XML/SAX/PurePerl/DTDDecls.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/XML/SAX/PurePerl/DTDDecls.pm
deleted file mode 100644
index 84c49e3e018..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/XML/SAX/PurePerl/DTDDecls.pm
+++ /dev/null
@@ -1,603 +0,0 @@
-# $Id: DTDDecls.pm,v 1.7 2005/10/14 20:31:20 matt Exp $
-
-package XML::SAX::PurePerl;
-
-use strict;
-use XML::SAX::PurePerl::Productions qw($NameChar $SingleChar);
-
-sub elementdecl {
- my ($self, $reader) = @_;
-
- my $data = $reader->data(9);
- return 0 unless $data =~ /^<!ELEMENT/;
- $reader->move_along(9);
-
- $self->skip_whitespace($reader) ||
- $self->parser_error("No whitespace after ELEMENT declaration", $reader);
-
- my $name = $self->Name($reader);
-
- $self->skip_whitespace($reader) ||
- $self->parser_error("No whitespace after ELEMENT's name", $reader);
-
- $self->contentspec($reader, $name);
-
- $self->skip_whitespace($reader);
-
- $reader->match('>') or $self->parser_error("Closing angle bracket not found on ELEMENT declaration", $reader);
-
- return 1;
-}
-
-sub contentspec {
- my ($self, $reader, $name) = @_;
-
- my $data = $reader->data(5);
-
- my $model;
- if ($data =~ /^EMPTY/) {
- $reader->move_along(5);
- $model = 'EMPTY';
- }
- elsif ($data =~ /^ANY/) {
- $reader->move_along(3);
- $model = 'ANY';
- }
- else {
- $model = $self->Mixed_or_children($reader);
- }
-
- if ($model) {
- # call SAX callback now.
- $self->element_decl({Name => $name, Model => $model});
- return 1;
- }
-
- $self->parser_error("contentspec not found in ELEMENT declaration", $reader);
-}
-
-sub Mixed_or_children {
- my ($self, $reader) = @_;
-
- my $data = $reader->data(8);
- $data =~ /^\(/ or return; # $self->parser_error("No opening bracket in Mixed or children", $reader);
-
- if ($data =~ /^\(\s*\#PCDATA/) {
- $reader->match('(');
- $self->skip_whitespace($reader);
- $reader->move_along(7);
- my $model = $self->Mixed($reader);
- return $model;
- }
-
- # not matched - must be Children
- return $self->children($reader);
-}
-
-# Mixed ::= ( '(' S* PCDATA ( S* '|' S* QName )* S* ')' '*' )
-# | ( '(' S* PCDATA S* ')' )
-sub Mixed {
- my ($self, $reader) = @_;
-
- # Mixed_or_children already matched '(' S* '#PCDATA'
-
- my $model = '(#PCDATA';
-
- $self->skip_whitespace($reader);
-
- my %seen;
-
- while (1) {
- last unless $reader->match('|');
- $self->skip_whitespace($reader);
-
- my $name = $self->Name($reader) ||
- $self->parser_error("No 'Name' after Mixed content '|'", $reader);
-
- if ($seen{$name}) {
- $self->parser_error("Element '$name' has already appeared in this group", $reader);
- }
- $seen{$name}++;
-
- $model .= "|$name";
-
- $self->skip_whitespace($reader);
- }
-
- $reader->match(')') || $self->parser_error("no closing bracket on mixed content", $reader);
-
- $model .= ")";
-
- if ($reader->match('*')) {
- $model .= "*";
- }
-
- return $model;
-}
-
-# [[47]] Children ::= ChoiceOrSeq Cardinality?
-# [[48]] Cp ::= ( QName | ChoiceOrSeq ) Cardinality?
-# ChoiceOrSeq ::= '(' S* Cp ( Choice | Seq )? S* ')'
-# [[49]] Choice ::= ( S* '|' S* Cp )+
-# [[50]] Seq ::= ( S* ',' S* Cp )+
-# // Children ::= (Choice | Seq) Cardinality?
-# // Cp ::= ( QName | Choice | Seq) Cardinality?
-# // Choice ::= '(' S* Cp ( S* '|' S* Cp )+ S* ')'
-# // Seq ::= '(' S* Cp ( S* ',' S* Cp )* S* ')'
-# [[51]] Mixed ::= ( '(' S* PCDATA ( S* '|' S* QName )* S* ')' MixedCardinality )
-# | ( '(' S* PCDATA S* ')' )
-# Cardinality ::= '?' | '+' | '*'
-# MixedCardinality ::= '*'
-sub children {
- my ($self, $reader) = @_;
-
- return $self->ChoiceOrSeq($reader) . $self->Cardinality($reader);
-}
-
-sub ChoiceOrSeq {
- my ($self, $reader) = @_;
-
- $reader->match('(') or $self->parser_error("choice/seq contains no opening bracket", $reader);
-
- my $model = '(';
-
- $self->skip_whitespace($reader);
-
- $model .= $self->Cp($reader);
-
- if (my $choice = $self->Choice($reader)) {
- $model .= $choice;
- }
- else {
- $model .= $self->Seq($reader);
- }
-
- $self->skip_whitespace($reader);
-
- $reader->match(')') or $self->parser_error("choice/seq contains no closing bracket", $reader);
-
- $model .= ')';
-
- return $model;
-}
-
-sub Cardinality {
- my ($self, $reader) = @_;
- # cardinality is always optional
- my $data = $reader->data;
- if ($data =~ /^([\?\+\*])/) {
- $reader->move_along(1);
- return $1;
- }
- return '';
-}
-
-sub Cp {
- my ($self, $reader) = @_;
-
- my $model;
- my $name = eval
- {
- if (my $name = $self->Name($reader)) {
- return $name . $self->Cardinality($reader);
- }
- };
- return $name if defined $name;
- return $self->ChoiceOrSeq($reader) . $self->Cardinality($reader);
-}
-
-sub Choice {
- my ($self, $reader) = @_;
-
- my $model = '';
- $self->skip_whitespace($reader);
-
- while ($reader->match('|')) {
- $self->skip_whitespace($reader);
- $model .= '|';
- $model .= $self->Cp($reader);
- $self->skip_whitespace($reader);
- }
-
- return $model;
-}
-
-sub Seq {
- my ($self, $reader) = @_;
-
- my $model = '';
- $self->skip_whitespace($reader);
-
- while ($reader->match(',')) {
- $self->skip_whitespace($reader);
- my $cp = $self->Cp($reader);
- if ($cp) {
- $model .= ',';
- $model .= $cp;
- }
- $self->skip_whitespace($reader);
- }
-
- return $model;
-}
-
-sub AttlistDecl {
- my ($self, $reader) = @_;
-
- my $data = $reader->data(9);
- if ($data =~ /^<!ATTLIST/) {
- # It's an attlist
-
- $reader->move_along(9);
-
- $self->skip_whitespace($reader) ||
- $self->parser_error("No whitespace after ATTLIST declaration", $reader);
- my $name = $self->Name($reader);
-
- $self->AttDefList($reader, $name);
-
- $self->skip_whitespace($reader);
-
- $reader->match('>') or $self->parser_error("Closing angle bracket not found on ATTLIST declaration", $reader);
-
- return 1;
- }
-
- return 0;
-}
-
-sub AttDefList {
- my ($self, $reader, $name) = @_;
-
- 1 while $self->AttDef($reader, $name);
-}
-
-sub AttDef {
- my ($self, $reader, $el_name) = @_;
-
- $self->skip_whitespace($reader) || return 0;
- my $att_name = $self->Name($reader) || return 0;
- $self->skip_whitespace($reader) ||
- $self->parser_error("No whitespace after Name in attribute definition", $reader);
- my $att_type = $self->AttType($reader);
-
- $self->skip_whitespace($reader) ||
- $self->parser_error("No whitespace after AttType in attribute definition", $reader);
- my ($mode, $value) = $self->DefaultDecl($reader);
-
- # fire SAX event here!
- $self->attribute_decl({
- eName => $el_name,
- aName => $att_name,
- Type => $att_type,
- Mode => $mode,
- Value => $value,
- });
- return 1;
-}
-
-sub AttType {
- my ($self, $reader) = @_;
-
- return $self->StringType($reader) ||
- $self->TokenizedType($reader) ||
- $self->EnumeratedType($reader) ||
- $self->parser_error("Can't match AttType", $reader);
-}
-
-sub StringType {
- my ($self, $reader) = @_;
-
- my $data = $reader->data(5);
- return unless $data =~ /^CDATA/;
- $reader->move_along(5);
- return 'CDATA';
-}
-
-sub TokenizedType {
- my ($self, $reader) = @_;
-
- my $data = $reader->data(8);
- if ($data =~ /^(IDREFS?|ID|ENTITIES|ENTITY|NMTOKENS?)/) {
- $reader->move_along(length($1));
- return $1;
- }
- return;
-}
-
-sub EnumeratedType {
- my ($self, $reader) = @_;
- return $self->NotationType($reader) || $self->Enumeration($reader);
-}
-
-sub NotationType {
- my ($self, $reader) = @_;
-
- my $data = $reader->data(8);
- return unless $data =~ /^NOTATION/;
- $reader->move_along(8);
-
- $self->skip_whitespace($reader) ||
- $self->parser_error("No whitespace after NOTATION", $reader);
- $reader->match('(') or $self->parser_error("No opening bracket in notation section", $reader);
-
- $self->skip_whitespace($reader);
- my $model = 'NOTATION (';
- my $name = $self->Name($reader) ||
- $self->parser_error("No name in notation section", $reader);
- $model .= $name;
- $self->skip_whitespace($reader);
- $data = $reader->data;
- while ($data =~ /^\|/) {
- $reader->move_along(1);
- $model .= '|';
- $self->skip_whitespace($reader);
- my $name = $self->Name($reader) ||
- $self->parser_error("No name in notation section", $reader);
- $model .= $name;
- $self->skip_whitespace($reader);
- $data = $reader->data;
- }
- $data =~ /^\)/ or $self->parser_error("No closing bracket in notation section", $reader);
- $reader->move_along(1);
-
- $model .= ')';
-
- return $model;
-}
-
-sub Enumeration {
- my ($self, $reader) = @_;
-
- return unless $reader->match('(');
-
- $self->skip_whitespace($reader);
- my $model = '(';
- my $nmtoken = $self->Nmtoken($reader) ||
- $self->parser_error("No Nmtoken in enumerated declaration", $reader);
- $model .= $nmtoken;
- $self->skip_whitespace($reader);
- my $data = $reader->data;
- while ($data =~ /^\|/) {
- $model .= '|';
- $reader->move_along(1);
- $self->skip_whitespace($reader);
- my $nmtoken = $self->Nmtoken($reader) ||
- $self->parser_error("No Nmtoken in enumerated declaration", $reader);
- $model .= $nmtoken;
- $self->skip_whitespace($reader);
- $data = $reader->data;
- }
- $data =~ /^\)/ or $self->parser_error("No closing bracket in enumerated declaration", $reader);
- $reader->move_along(1);
-
- $model .= ')';
-
- return $model;
-}
-
-sub Nmtoken {
- my ($self, $reader) = @_;
- return $self->Name($reader);
-}
-
-sub DefaultDecl {
- my ($self, $reader) = @_;
-
- my $data = $reader->data(9);
- if ($data =~ /^(\#REQUIRED|\#IMPLIED)/) {
- $reader->move_along(length($1));
- return $1;
- }
- my $model = '';
- if ($data =~ /^\#FIXED/) {
- $reader->move_along(6);
- $self->skip_whitespace($reader) || $self->parser_error(
- "no whitespace after FIXED specifier", $reader);
- my $value = $self->AttValue($reader);
- return "#FIXED", $value;
- }
- my $value = $self->AttValue($reader);
- return undef, $value;
-}
-
-sub EntityDecl {
- my ($self, $reader) = @_;
-
- my $data = $reader->data(8);
- return 0 unless $data =~ /^<!ENTITY/;
- $reader->move_along(8);
-
- $self->skip_whitespace($reader) || $self->parser_error(
- "No whitespace after ENTITY declaration", $reader);
-
- $self->PEDecl($reader) || $self->GEDecl($reader);
-
- $self->skip_whitespace($reader);
-
- $reader->match('>') or $self->parser_error("No closing '>' in entity definition", $reader);
-
- return 1;
-}
-
-sub GEDecl {
- my ($self, $reader) = @_;
-
- my $name = $self->Name($reader) || $self->parser_error("No entity name given", $reader);
- $self->skip_whitespace($reader) || $self->parser_error("No whitespace after entity name", $reader);
-
- # TODO: ExternalID calls lexhandler method. Wrong place for it.
- my $value;
- if ($value = $self->ExternalID($reader)) {
- $value .= $self->NDataDecl($reader);
- }
- else {
- $value = $self->EntityValue($reader);
- }
-
- if ($self->{ParseOptions}{entities}{$name}) {
- warn("entity $name already exists\n");
- } else {
- $self->{ParseOptions}{entities}{$name} = 1;
- $self->{ParseOptions}{expanded_entity}{$name} = $value; # ???
- }
- # do callback?
- return 1;
-}
-
-sub PEDecl {
- my ($self, $reader) = @_;
-
- return 0 unless $reader->match('%');
-
- $self->skip_whitespace($reader) || $self->parser_error("No whitespace after parameter entity marker", $reader);
- my $name = $self->Name($reader) || $self->parser_error("No parameter entity name given", $reader);
- $self->skip_whitespace($reader) || $self->parser_error("No whitespace after parameter entity name", $reader);
- my $value = $self->ExternalID($reader) ||
- $self->EntityValue($reader) ||
- $self->parser_error("PE is not a value or an external resource", $reader);
- # do callback?
- return 1;
-}
-
-my $quotre = qr/[^%&\"]/;
-my $aposre = qr/[^%&\']/;
-
-sub EntityValue {
- my ($self, $reader) = @_;
-
- my $data = $reader->data;
- my $quote = '"';
- my $re = $quotre;
- if (!$data =~ /^"/) {
- $data =~ /^'/ or $self->parser_error("Not a quote character", $reader);
- $quote = "'";
- $re = $aposre;
- }
- $reader->move_along(1);
-
- my $value = '';
-
- while (1) {
- my $data = $reader->data;
-
- $self->parser_error("EOF found while reading entity value", $reader)
- unless length($data);
-
- if ($data =~ /^($re+)/) {
- my $match = $1;
- $value .= $match;
- $reader->move_along(length($match));
- }
- elsif ($reader->match('&')) {
- # if it's a char ref, expand now:
- if ($reader->match('#')) {
- my $char;
- my $ref = '';
- if ($reader->match('x')) {
- my $data = $reader->data;
- while (1) {
- $self->parser_error("EOF looking for reference end", $reader)
- unless length($data);
- if ($data !~ /^([0-9a-fA-F]*)/) {
- last;
- }
- $ref .= $1;
- $reader->move_along(length($1));
- if (length($1) == length($data)) {
- $data = $reader->data;
- }
- else {
- last;
- }
- }
- $char = chr_ref(hex($ref));
- $ref = "x$ref";
- }
- else {
- my $data = $reader->data;
- while (1) {
- $self->parser_error("EOF looking for reference end", $reader)
- unless length($data);
- if ($data !~ /^([0-9]*)/) {
- last;
- }
- $ref .= $1;
- $reader->move_along(length($1));
- if (length($1) == length($data)) {
- $data = $reader->data;
- }
- else {
- last;
- }
- }
- $char = chr($ref);
- }
- $reader->match(';') ||
- $self->parser_error("No semi-colon found after character reference", $reader);
- if ($char !~ $SingleChar) { # match a single character
- $self->parser_error("Character reference '&#$ref;' refers to an illegal XML character ($char)", $reader);
- }
- $value .= $char;
- }
- else {
- # entity refs in entities get expanded later, so don't parse now.
- $value .= '&';
- }
- }
- elsif ($reader->match('%')) {
- $value .= $self->PEReference($reader);
- }
- elsif ($reader->match($quote)) {
- # end of attrib
- last;
- }
- else {
- $self->parser_error("Invalid character in attribute value: " . substr($reader->data, 0, 1), $reader);
- }
- }
-
- return $value;
-}
-
-sub NDataDecl {
- my ($self, $reader) = @_;
- $self->skip_whitespace($reader) || return '';
- my $data = $reader->data(5);
- return '' unless $data =~ /^NDATA/;
- $reader->move_along(5);
- $self->skip_whitespace($reader) || $self->parser_error("No whitespace after NDATA declaration", $reader);
- my $name = $self->Name($reader) || $self->parser_error("NDATA declaration lacks a proper Name", $reader);
- return " NDATA $name";
-}
-
-sub NotationDecl {
- my ($self, $reader) = @_;
-
- my $data = $reader->data(10);
- return 0 unless $data =~ /^<!NOTATION/;
- $reader->move_along(10);
- $self->skip_whitespace($reader) ||
- $self->parser_error("No whitespace after NOTATION declaration", $reader);
- $data = $reader->data;
- my $value = '';
- while(1) {
- $self->parser_error("EOF found while looking for end of NotationDecl", $reader)
- unless length($data);
-
- if ($data =~ /^([^>]*)>/) {
- $value .= $1;
- $reader->move_along(length($1) + 1);
- $self->notation_decl({Name => "FIXME", SystemId => "FIXME", PublicId => "FIXME" });
- last;
- }
- else {
- $value .= $data;
- $reader->move_along(length($data));
- $data = $reader->data;
- }
- }
- return 1;
-}
-
-1;
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/XML/SAX/PurePerl/DebugHandler.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/XML/SAX/PurePerl/DebugHandler.pm
deleted file mode 100644
index 4efdf0b6c2d..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/XML/SAX/PurePerl/DebugHandler.pm
+++ /dev/null
@@ -1,95 +0,0 @@
-# $Id: DebugHandler.pm,v 1.3 2001/11/24 17:47:53 matt Exp $
-
-package XML::SAX::PurePerl::DebugHandler;
-
-use strict;
-
-sub new {
- my $class = shift;
- my %opts = @_;
- return bless \%opts, $class;
-}
-
-# DocumentHandler
-
-sub set_document_locator {
- my $self = shift;
- print "set_document_locator\n" if $ENV{DEBUG_XML};
- $self->{seen}{set_document_locator}++;
-}
-
-sub start_document {
- my $self = shift;
- print "start_document\n" if $ENV{DEBUG_XML};
- $self->{seen}{start_document}++;
-}
-
-sub end_document {
- my $self = shift;
- print "end_document\n" if $ENV{DEBUG_XML};
- $self->{seen}{end_document}++;
-}
-
-sub start_element {
- my $self = shift;
- print "start_element\n" if $ENV{DEBUG_XML};
- $self->{seen}{start_element}++;
-}
-
-sub end_element {
- my $self = shift;
- print "end_element\n" if $ENV{DEBUG_XML};
- $self->{seen}{end_element}++;
-}
-
-sub characters {
- my $self = shift;
- print "characters\n" if $ENV{DEBUG_XML};
-# warn "Char: ", $_[0]->{Data}, "\n";
- $self->{seen}{characters}++;
-}
-
-sub processing_instruction {
- my $self = shift;
- print "processing_instruction\n" if $ENV{DEBUG_XML};
- $self->{seen}{processing_instruction}++;
-}
-
-sub ignorable_whitespace {
- my $self = shift;
- print "ignorable_whitespace\n" if $ENV{DEBUG_XML};
- $self->{seen}{ignorable_whitespace}++;
-}
-
-# LexHandler
-
-sub comment {
- my $self = shift;
- print "comment\n" if $ENV{DEBUG_XML};
- $self->{seen}{comment}++;
-}
-
-# DTDHandler
-
-sub notation_decl {
- my $self = shift;
- print "notation_decl\n" if $ENV{DEBUG_XML};
- $self->{seen}{notation_decl}++;
-}
-
-sub unparsed_entity_decl {
- my $self = shift;
- print "unparsed_entity_decl\n" if $ENV{DEBUG_XML};
- $self->{seen}{entity_decl}++;
-}
-
-# EntityResolver
-
-sub resolve_entity {
- my $self = shift;
- print "resolve_entity\n" if $ENV{DEBUG_XML};
- $self->{seen}{resolve_entity}++;
- return '';
-}
-
-1;
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/XML/SAX/PurePerl/DocType.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/XML/SAX/PurePerl/DocType.pm
deleted file mode 100644
index bbefec82004..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/XML/SAX/PurePerl/DocType.pm
+++ /dev/null
@@ -1,180 +0,0 @@
-# $Id: DocType.pm,v 1.3 2003/07/30 13:39:22 matt Exp $
-
-package XML::SAX::PurePerl;
-
-use strict;
-use XML::SAX::PurePerl::Productions qw($PubidChar);
-
-sub doctypedecl {
- my ($self, $reader) = @_;
-
- my $data = $reader->data(9);
- if ($data =~ /^<!DOCTYPE/) {
- $reader->move_along(9);
- $self->skip_whitespace($reader) ||
- $self->parser_error("No whitespace after doctype declaration", $reader);
-
- my $root_name = $self->Name($reader) ||
- $self->parser_error("Doctype declaration has no root element name", $reader);
-
- if ($self->skip_whitespace($reader)) {
- # might be externalid...
- my %dtd = $self->ExternalID($reader);
- # TODO: Call SAX event
- }
-
- $self->skip_whitespace($reader);
-
- $self->InternalSubset($reader);
-
- $reader->match('>') or $self->parser_error("Doctype not closed", $reader);
-
- return 1;
- }
-
- return 0;
-}
-
-sub ExternalID {
- my ($self, $reader) = @_;
-
- my $data = $reader->data(6);
-
- if ($data =~ /^SYSTEM/) {
- $reader->move_along(6);
- $self->skip_whitespace($reader) ||
- $self->parser_error("No whitespace after SYSTEM identifier", $reader);
- return (SYSTEM => $self->SystemLiteral($reader));
- }
- elsif ($data =~ /^PUBLIC/) {
- $reader->move_along(6);
- $self->skip_whitespace($reader) ||
- $self->parser_error("No whitespace after PUBLIC identifier", $reader);
-
- my $quote = $self->quote($reader) ||
- $self->parser_error("Not a quote character in PUBLIC identifier", $reader);
-
- my $data = $reader->data;
- my $pubid = '';
- while(1) {
- $self->parser_error("EOF while looking for end of PUBLIC identifiier", $reader)
- unless length($data);
-
- if ($data =~ /^([^$quote]*)$quote/) {
- $pubid .= $1;
- $reader->move_along(length($1) + 1);
- last;
- }
- else {
- $pubid .= $data;
- $reader->move_along(length($data));
- $data = $reader->data;
- }
- }
-
- if ($pubid !~ /^($PubidChar)+$/) {
- $self->parser_error("Invalid characters in PUBLIC identifier", $reader);
- }
-
- $self->skip_whitespace($reader) ||
- $self->parser_error("Not whitespace after PUBLIC ID in DOCTYPE", $reader);
-
- return (PUBLIC => $pubid,
- SYSTEM => $self->SystemLiteral($reader));
- }
- else {
- return;
- }
-
- return 1;
-}
-
-sub SystemLiteral {
- my ($self, $reader) = @_;
-
- my $quote = $self->quote($reader);
-
- my $data = $reader->data;
- my $systemid = '';
- while (1) {
- $self->parser_error("EOF found while looking for end of Sytem Literal", $reader)
- unless length($data);
- if ($data =~ /^([^$quote]*)$quote/) {
- $systemid .= $1;
- $reader->move_along(length($1) + 1);
- return $systemid;
- }
- else {
- $systemid .= $data;
- $reader->move_along(length($data));
- $data = $reader->data;
- }
- }
-}
-
-sub InternalSubset {
- my ($self, $reader) = @_;
-
- return 0 unless $reader->match('[');
-
- 1 while $self->IntSubsetDecl($reader);
-
- $reader->match(']') or $self->parser_error("No close bracket on internal subset (found: " . $reader->data, $reader);
- $self->skip_whitespace($reader);
- return 1;
-}
-
-sub IntSubsetDecl {
- my ($self, $reader) = @_;
-
- return $self->DeclSep($reader) || $self->markupdecl($reader);
-}
-
-sub DeclSep {
- my ($self, $reader) = @_;
-
- if ($self->skip_whitespace($reader)) {
- return 1;
- }
-
- if ($self->PEReference($reader)) {
- return 1;
- }
-
-# if ($self->ParsedExtSubset($reader)) {
-# return 1;
-# }
-
- return 0;
-}
-
-sub PEReference {
- my ($self, $reader) = @_;
-
- return 0 unless $reader->match('%');
-
- my $peref = $self->Name($reader) ||
- $self->parser_error("PEReference did not find a Name", $reader);
- # TODO - load/parse the peref
-
- $reader->match(';') or $self->parser_error("Invalid token in PEReference", $reader);
- return 1;
-}
-
-sub markupdecl {
- my ($self, $reader) = @_;
-
- if ($self->elementdecl($reader) ||
- $self->AttlistDecl($reader) ||
- $self->EntityDecl($reader) ||
- $self->NotationDecl($reader) ||
- $self->PI($reader) ||
- $self->Comment($reader))
- {
- return 1;
- }
-
- return 0;
-}
-
-1;
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/XML/SAX/PurePerl/EncodingDetect.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/XML/SAX/PurePerl/EncodingDetect.pm
deleted file mode 100644
index babdc5a9db4..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/XML/SAX/PurePerl/EncodingDetect.pm
+++ /dev/null
@@ -1,105 +0,0 @@
-# $Id: EncodingDetect.pm,v 1.6 2007/02/07 09:33:50 grant Exp $
-
-package XML::SAX::PurePerl; # NB, not ::EncodingDetect!
-
-use strict;
-
-sub encoding_detect {
- my ($parser, $reader) = @_;
-
- my $error = "Invalid byte sequence at start of file";
-
- my $data = $reader->data;
- if ($data =~ /^\x00\x00\xFE\xFF/) {
- # BO-UCS4-be
- $reader->move_along(4);
- $reader->set_encoding('UCS-4BE');
- return;
- }
- elsif ($data =~ /^\x00\x00\xFF\xFE/) {
- # BO-UCS-4-2143
- $reader->move_along(4);
- $reader->set_encoding('UCS-4-2143');
- return;
- }
- elsif ($data =~ /^\x00\x00\x00\x3C/) {
- $reader->set_encoding('UCS-4BE');
- return;
- }
- elsif ($data =~ /^\x00\x00\x3C\x00/) {
- $reader->set_encoding('UCS-4-2143');
- return;
- }
- elsif ($data =~ /^\x00\x3C\x00\x00/) {
- $reader->set_encoding('UCS-4-3412');
- return;
- }
- elsif ($data =~ /^\x00\x3C\x00\x3F/) {
- $reader->set_encoding('UTF-16BE');
- return;
- }
- elsif ($data =~ /^\xFF\xFE\x00\x00/) {
- # BO-UCS-4LE
- $reader->move_along(4);
- $reader->set_encoding('UCS-4LE');
- return;
- }
- elsif ($data =~ /^\xFF\xFE/) {
- $reader->move_along(2);
- $reader->set_encoding('UTF-16LE');
- return;
- }
- elsif ($data =~ /^\xFE\xFF\x00\x00/) {
- $reader->move_along(4);
- $reader->set_encoding('UCS-4-3412');
- return;
- }
- elsif ($data =~ /^\xFE\xFF/) {
- $reader->move_along(2);
- $reader->set_encoding('UTF-16BE');
- return;
- }
- elsif ($data =~ /^\xEF\xBB\xBF/) { # UTF-8 BOM
- $reader->move_along(3);
- $reader->set_encoding('UTF-8');
- return;
- }
- elsif ($data =~ /^\x3C\x00\x00\x00/) {
- $reader->set_encoding('UCS-4LE');
- return;
- }
- elsif ($data =~ /^\x3C\x00\x3F\x00/) {
- $reader->set_encoding('UTF-16LE');
- return;
- }
- elsif ($data =~ /^\x3C\x3F\x78\x6D/) {
- # $reader->set_encoding('UTF-8');
- return;
- }
- elsif ($data =~ /^\x3C\x3F\x78/) {
- # $reader->set_encoding('UTF-8');
- return;
- }
- elsif ($data =~ /^\x3C\x3F/) {
- # $reader->set_encoding('UTF-8');
- return;
- }
- elsif ($data =~ /^\x3C/) {
- # $reader->set_encoding('UTF-8');
- return;
- }
- elsif ($data =~ /^[\x20\x09\x0A\x0D]+\x3C[^\x3F]/) {
- # $reader->set_encoding('UTF-8');
- return;
- }
- elsif ($data =~ /^\x4C\x6F\xA7\x94/) {
- $reader->set_encoding('EBCDIC');
- return;
- }
-
- warn("Unable to recognise encoding of this document");
- return;
-}
-
-1;
-
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/XML/SAX/PurePerl/Exception.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/XML/SAX/PurePerl/Exception.pm
deleted file mode 100644
index fb6b171f3b8..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/XML/SAX/PurePerl/Exception.pm
+++ /dev/null
@@ -1,67 +0,0 @@
-# $Id: Exception.pm,v 1.2 2001/11/14 11:07:25 matt Exp $
-
-package XML::SAX::PurePerl::Exception;
-
-use strict;
-
-use overload '""' => "stringify";
-
-use vars qw/$StackTrace/;
-
-$StackTrace = $ENV{XML_DEBUG} || 0;
-
-sub throw {
- my $class = shift;
- die $class->new(@_);
-}
-
-sub new {
- my $class = shift;
- my %opts = @_;
- die "Invalid options" unless exists $opts{Message};
-
- if ($opts{reader}) {
- return bless { Message => $opts{Message},
- Exception => undef, # not sure what this is for!!!
- ColumnNumber => $opts{reader}->column,
- LineNumber => $opts{reader}->line,
- PublicId => $opts{reader}->public_id,
- SystemId => $opts{reader}->system_id,
- $StackTrace ? (StackTrace => stacktrace()) : (),
- }, $class;
- }
- return bless { Message => $opts{Message},
- Exception => undef, # not sure what this is for!!!
- }, $class;
-}
-
-sub stringify {
- my $self = shift;
- local $^W;
- return $self->{Message} . " [Ln: " . $self->{LineNumber} .
- ", Col: " . $self->{ColumnNumber} . "]" .
- ($StackTrace ? stackstring($self->{StackTrace}) : "") . "\n";
-}
-
-sub stacktrace {
- my $i = 2;
- my @fulltrace;
- while (my @trace = caller($i++)) {
- my %hash;
- @hash{qw(Package Filename Line)} = @trace[0..2];
- push @fulltrace, \%hash;
- }
- return \@fulltrace;
-}
-
-sub stackstring {
- my $stacktrace = shift;
- my $string = "\nFrom:\n";
- foreach my $current (@$stacktrace) {
- $string .= $current->{Filename} . " Line: " . $current->{Line} . "\n";
- }
- return $string;
-}
-
-1;
-
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/XML/SAX/PurePerl/NoUnicodeExt.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/XML/SAX/PurePerl/NoUnicodeExt.pm
deleted file mode 100644
index 5e357693713..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/XML/SAX/PurePerl/NoUnicodeExt.pm
+++ /dev/null
@@ -1,28 +0,0 @@
-# $Id: NoUnicodeExt.pm,v 1.1 2002/01/30 17:35:21 matt Exp $
-
-package XML::SAX::PurePerl;
-use strict;
-
-sub chr_ref {
- my $n = shift;
- if ($n < 0x80) {
- return chr ($n);
- }
- elsif ($n < 0x800) {
- return pack ("CC", (($n >> 6) | 0xc0), (($n & 0x3f) | 0x80));
- }
- elsif ($n < 0x10000) {
- return pack ("CCC", (($n >> 12) | 0xe0), ((($n >> 6) & 0x3f) | 0x80),
- (($n & 0x3f) | 0x80));
- }
- elsif ($n < 0x110000)
- {
- return pack ("CCCC", (($n >> 18) | 0xf0), ((($n >> 12) & 0x3f) | 0x80),
- ((($n >> 6) & 0x3f) | 0x80), (($n & 0x3f) | 0x80));
- }
- else {
- return undef;
- }
-}
-
-1;
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/XML/SAX/PurePerl/Productions.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/XML/SAX/PurePerl/Productions.pm
deleted file mode 100644
index 7fd7f3c7fbc..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/XML/SAX/PurePerl/Productions.pm
+++ /dev/null
@@ -1,151 +0,0 @@
-# $Id: Productions.pm,v 1.11 2003/07/30 13:39:22 matt Exp $
-
-package XML::SAX::PurePerl::Productions;
-
-use Exporter;
-@ISA = ('Exporter');
-@EXPORT_OK = qw($S $Char $VersionNum $BaseChar $Letter $Ideographic
- $Extender $Digit $CombiningChar $EncNameStart $EncNameEnd $NameChar $CharMinusDash
- $PubidChar $Any $SingleChar);
-
-### WARNING!!! All productions here must *only* match a *single* character!!! ###
-
-BEGIN {
-$S = qr/[\x20\x09\x0D\x0A]/;
-
-$CharMinusDash = qr/[^-]/x;
-
-$Any = qr/ . /xms;
-
-$VersionNum = qr/ [a-zA-Z0-9_.:-]+ /x;
-
-$EncNameStart = qr/ [A-Za-z] /x;
-$EncNameEnd = qr/ [A-Za-z0-9\._-] /x;
-
-$PubidChar = qr/ [\x20\x0D\x0Aa-zA-Z0-9'()\+,.\/:=\?;!*\#@\$_\%-] /x;
-
-if ($] < 5.006) {
- eval <<' PERL';
- $Char = qr/^ [\x09\x0A\x0D\x20-\x7F]|([\xC0-\xFD][\x80-\xBF]+) $/x;
-
- $SingleChar = qr/^$Char$/;
-
- $BaseChar = qr/ [\x41-\x5A\x61-\x7A]|([\xC0-\xFD][\x80-\xBF]+) /x;
-
- $Extender = qr/ \xB7 /x;
-
- $Digit = qr/ [\x30-\x39] /x;
-
- $Letter = qr/^ $BaseChar $/x;
-
- # can't do this one without unicode
- # $CombiningChar = qr/^$/msx;
-
- $NameChar = qr/^ $BaseChar | $Digit | [._:-] | $Extender $/x;
- PERL
- die $@ if $@;
-}
-else {
- eval <<' PERL';
-
- use utf8; # for 5.6
-
- $Char = qr/^ [\x09\x0A\x0D\x{0020}-\x{D7FF}\x{E000}-\x{FFFD}\x{10000}-\x{10FFFF}] $/x;
-
- $SingleChar = qr/^$Char$/;
-
- $BaseChar = qr/
-[\x{0041}-\x{005A}\x{0061}-\x{007A}\x{00C0}-\x{00D6}\x{00D8}-\x{00F6}] |
-[\x{00F8}-\x{00FF}\x{0100}-\x{0131}\x{0134}-\x{013E}\x{0141}-\x{0148}] |
-[\x{014A}-\x{017E}\x{0180}-\x{01C3}\x{01CD}-\x{01F0}\x{01F4}-\x{01F5}] |
-[\x{01FA}-\x{0217}\x{0250}-\x{02A8}\x{02BB}-\x{02C1}\x{0386}\x{0388}-\x{038A}] |
-[\x{038C}\x{038E}-\x{03A1}\x{03A3}-\x{03CE}\x{03D0}-\x{03D6}\x{03DA}] |
-[\x{03DC}\x{03DE}\x{03E0}\x{03E2}-\x{03F3}\x{0401}-\x{040C}\x{040E}-\x{044F}] |
-[\x{0451}-\x{045C}\x{045E}-\x{0481}\x{0490}-\x{04C4}\x{04C7}-\x{04C8}] |
-[\x{04CB}-\x{04CC}\x{04D0}-\x{04EB}\x{04EE}-\x{04F5}\x{04F8}-\x{04F9}] |
-[\x{0531}-\x{0556}\x{0559}\x{0561}-\x{0586}\x{05D0}-\x{05EA}\x{05F0}-\x{05F2}] |
-[\x{0621}-\x{063A}\x{0641}-\x{064A}\x{0671}-\x{06B7}\x{06BA}-\x{06BE}] |
-[\x{06C0}-\x{06CE}\x{06D0}-\x{06D3}\x{06D5}\x{06E5}-\x{06E6}\x{0905}-\x{0939}] |
-[\x{093D}\x{0958}-\x{0961}\x{0985}-\x{098C}\x{098F}-\x{0990}] |
-[\x{0993}-\x{09A8}\x{09AA}-\x{09B0}\x{09B2}\x{09B6}-\x{09B9}\x{09DC}-\x{09DD}] |
-[\x{09DF}-\x{09E1}\x{09F0}-\x{09F1}\x{0A05}-\x{0A0A}\x{0A0F}-\x{0A10}] |
-[\x{0A13}-\x{0A28}\x{0A2A}-\x{0A30}\x{0A32}-\x{0A33}\x{0A35}-\x{0A36}] |
-[\x{0A38}-\x{0A39}\x{0A59}-\x{0A5C}\x{0A5E}\x{0A72}-\x{0A74}\x{0A85}-\x{0A8B}] |
-[\x{0A8D}\x{0A8F}-\x{0A91}\x{0A93}-\x{0AA8}\x{0AAA}-\x{0AB0}] |
-[\x{0AB2}-\x{0AB3}\x{0AB5}-\x{0AB9}\x{0ABD}\x{0AE0}\x{0B05}-\x{0B0C}] |
-[\x{0B0F}-\x{0B10}\x{0B13}-\x{0B28}\x{0B2A}-\x{0B30}\x{0B32}-\x{0B33}] |
-[\x{0B36}-\x{0B39}\x{0B3D}\x{0B5C}-\x{0B5D}\x{0B5F}-\x{0B61}\x{0B85}-\x{0B8A}] |
-[\x{0B8E}-\x{0B90}\x{0B92}-\x{0B95}\x{0B99}-\x{0B9A}\x{0B9C}] |
-[\x{0B9E}-\x{0B9F}\x{0BA3}-\x{0BA4}\x{0BA8}-\x{0BAA}\x{0BAE}-\x{0BB5}] |
-[\x{0BB7}-\x{0BB9}\x{0C05}-\x{0C0C}\x{0C0E}-\x{0C10}\x{0C12}-\x{0C28}] |
-[\x{0C2A}-\x{0C33}\x{0C35}-\x{0C39}\x{0C60}-\x{0C61}\x{0C85}-\x{0C8C}] |
-[\x{0C8E}-\x{0C90}\x{0C92}-\x{0CA8}\x{0CAA}-\x{0CB3}\x{0CB5}-\x{0CB9}\x{0CDE}] |
-[\x{0CE0}-\x{0CE1}\x{0D05}-\x{0D0C}\x{0D0E}-\x{0D10}\x{0D12}-\x{0D28}] |
-[\x{0D2A}-\x{0D39}\x{0D60}-\x{0D61}\x{0E01}-\x{0E2E}\x{0E30}\x{0E32}-\x{0E33}] |
-[\x{0E40}-\x{0E45}\x{0E81}-\x{0E82}\x{0E84}\x{0E87}-\x{0E88}\x{0E8A}] |
-[\x{0E8D}\x{0E94}-\x{0E97}\x{0E99}-\x{0E9F}\x{0EA1}-\x{0EA3}\x{0EA5}\x{0EA7}] |
-[\x{0EAA}-\x{0EAB}\x{0EAD}-\x{0EAE}\x{0EB0}\x{0EB2}-\x{0EB3}\x{0EBD}] |
-[\x{0EC0}-\x{0EC4}\x{0F40}-\x{0F47}\x{0F49}-\x{0F69}\x{10A0}-\x{10C5}] |
-[\x{10D0}-\x{10F6}\x{1100}\x{1102}-\x{1103}\x{1105}-\x{1107}\x{1109}] |
-[\x{110B}-\x{110C}\x{110E}-\x{1112}\x{113C}\x{113E}\x{1140}\x{114C}\x{114E}] |
-[\x{1150}\x{1154}-\x{1155}\x{1159}\x{115F}-\x{1161}\x{1163}\x{1165}] |
-[\x{1167}\x{1169}\x{116D}-\x{116E}\x{1172}-\x{1173}\x{1175}\x{119E}\x{11A8}] |
-[\x{11AB}\x{11AE}-\x{11AF}\x{11B7}-\x{11B8}\x{11BA}\x{11BC}-\x{11C2}] |
-[\x{11EB}\x{11F0}\x{11F9}\x{1E00}-\x{1E9B}\x{1EA0}-\x{1EF9}\x{1F00}-\x{1F15}] |
-[\x{1F18}-\x{1F1D}\x{1F20}-\x{1F45}\x{1F48}-\x{1F4D}\x{1F50}-\x{1F57}] |
-[\x{1F59}\x{1F5B}\x{1F5D}\x{1F5F}-\x{1F7D}\x{1F80}-\x{1FB4}\x{1FB6}-\x{1FBC}] |
-[\x{1FBE}\x{1FC2}-\x{1FC4}\x{1FC6}-\x{1FCC}\x{1FD0}-\x{1FD3}] |
-[\x{1FD6}-\x{1FDB}\x{1FE0}-\x{1FEC}\x{1FF2}-\x{1FF4}\x{1FF6}-\x{1FFC}] |
-[\x{2126}\x{212A}-\x{212B}\x{212E}\x{2180}-\x{2182}\x{3041}-\x{3094}] |
-[\x{30A1}-\x{30FA}\x{3105}-\x{312C}\x{AC00}-\x{D7A3}]
- /x;
-
- $Extender = qr/
-[\x{00B7}\x{02D0}\x{02D1}\x{0387}\x{0640}\x{0E46}\x{0EC6}\x{3005}\x{3031}-\x{3035}\x{309D}-\x{309E}\x{30FC}-\x{30FE}]
-/x;
-
- $Digit = qr/
-[\x{0030}-\x{0039}\x{0660}-\x{0669}\x{06F0}-\x{06F9}\x{0966}-\x{096F}] |
-[\x{09E6}-\x{09EF}\x{0A66}-\x{0A6F}\x{0AE6}-\x{0AEF}\x{0B66}-\x{0B6F}] |
-[\x{0BE7}-\x{0BEF}\x{0C66}-\x{0C6F}\x{0CE6}-\x{0CEF}\x{0D66}-\x{0D6F}] |
-[\x{0E50}-\x{0E59}\x{0ED0}-\x{0ED9}\x{0F20}-\x{0F29}]
-/x;
-
- $CombiningChar = qr/
-[\x{0300}-\x{0345}\x{0360}-\x{0361}\x{0483}-\x{0486}\x{0591}-\x{05A1}] |
-[\x{05A3}-\x{05B9}\x{05BB}-\x{05BD}\x{05BF}\x{05C1}-\x{05C2}\x{05C4}] |
-[\x{064B}-\x{0652}\x{0670}\x{06D6}-\x{06DC}\x{06DD}-\x{06DF}\x{06E0}-\x{06E4}] |
-[\x{06E7}-\x{06E8}\x{06EA}-\x{06ED}\x{0901}-\x{0903}\x{093C}] |
-[\x{093E}-\x{094C}\x{094D}\x{0951}-\x{0954}\x{0962}-\x{0963}\x{0981}-\x{0983}] |
-[\x{09BC}\x{09BE}\x{09BF}\x{09C0}-\x{09C4}\x{09C7}-\x{09C8}] |
-[\x{09CB}-\x{09CD}\x{09D7}\x{09E2}-\x{09E3}\x{0A02}\x{0A3C}\x{0A3E}\x{0A3F}] |
-[\x{0A40}-\x{0A42}\x{0A47}-\x{0A48}\x{0A4B}-\x{0A4D}\x{0A70}-\x{0A71}] |
-[\x{0A81}-\x{0A83}\x{0ABC}\x{0ABE}-\x{0AC5}\x{0AC7}-\x{0AC9}\x{0ACB}-\x{0ACD}] |
-[\x{0B01}-\x{0B03}\x{0B3C}\x{0B3E}-\x{0B43}\x{0B47}-\x{0B48}] |
-[\x{0B4B}-\x{0B4D}\x{0B56}-\x{0B57}\x{0B82}-\x{0B83}\x{0BBE}-\x{0BC2}] |
-[\x{0BC6}-\x{0BC8}\x{0BCA}-\x{0BCD}\x{0BD7}\x{0C01}-\x{0C03}\x{0C3E}-\x{0C44}] |
-[\x{0C46}-\x{0C48}\x{0C4A}-\x{0C4D}\x{0C55}-\x{0C56}\x{0C82}-\x{0C83}] |
-[\x{0CBE}-\x{0CC4}\x{0CC6}-\x{0CC8}\x{0CCA}-\x{0CCD}\x{0CD5}-\x{0CD6}] |
-[\x{0D02}-\x{0D03}\x{0D3E}-\x{0D43}\x{0D46}-\x{0D48}\x{0D4A}-\x{0D4D}\x{0D57}] |
-[\x{0E31}\x{0E34}-\x{0E3A}\x{0E47}-\x{0E4E}\x{0EB1}\x{0EB4}-\x{0EB9}] |
-[\x{0EBB}-\x{0EBC}\x{0EC8}-\x{0ECD}\x{0F18}-\x{0F19}\x{0F35}\x{0F37}\x{0F39}] |
-[\x{0F3E}\x{0F3F}\x{0F71}-\x{0F84}\x{0F86}-\x{0F8B}\x{0F90}-\x{0F95}] |
-[\x{0F97}\x{0F99}-\x{0FAD}\x{0FB1}-\x{0FB7}\x{0FB9}\x{20D0}-\x{20DC}\x{20E1}] |
-[\x{302A}-\x{302F}\x{3099}\x{309A}]
-/x;
-
- $Ideographic = qr/
-[\x{4E00}-\x{9FA5}\x{3007}\x{3021}-\x{3029}]
-/x;
-
- $Letter = qr/^ $BaseChar | $Ideographic $/x;
-
- $NameChar = qr/^ $Letter | $Digit | [._:-] | $CombiningChar | $Extender $/x;
- PERL
-
- die $@ if $@;
-}
-
-}
-
-1;
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/XML/SAX/PurePerl/Reader.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/XML/SAX/PurePerl/Reader.pm
deleted file mode 100644
index 4b185b1f293..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/XML/SAX/PurePerl/Reader.pm
+++ /dev/null
@@ -1,137 +0,0 @@
-# $Id: Reader.pm,v 1.11 2005/10/14 20:31:20 matt Exp $
-
-package XML::SAX::PurePerl::Reader;
-
-use strict;
-use XML::SAX::PurePerl::Reader::URI;
-use XML::SAX::PurePerl::Productions qw( $SingleChar $Letter $NameChar );
-use Exporter ();
-
-use vars qw(@ISA @EXPORT_OK);
-@ISA = qw(Exporter);
-@EXPORT_OK = qw(
- EOF
- BUFFER
- LINE
- COLUMN
- ENCODING
- XML_VERSION
-);
-
-use constant EOF => 0;
-use constant BUFFER => 1;
-use constant LINE => 2;
-use constant COLUMN => 3;
-use constant ENCODING => 4;
-use constant SYSTEM_ID => 5;
-use constant PUBLIC_ID => 6;
-use constant XML_VERSION => 7;
-
-require XML::SAX::PurePerl::Reader::Stream;
-require XML::SAX::PurePerl::Reader::String;
-
-if ($] >= 5.007002) {
- require XML::SAX::PurePerl::Reader::UnicodeExt;
-}
-else {
- require XML::SAX::PurePerl::Reader::NoUnicodeExt;
-}
-
-sub new {
- my $class = shift;
- my $thing = shift;
-
- # try to figure if this $thing is a handle of some sort
- if (ref($thing) && UNIVERSAL::isa($thing, 'IO::Handle')) {
- return XML::SAX::PurePerl::Reader::Stream->new($thing)->init;
- }
- my $ioref;
- if (tied($thing)) {
- my $class = ref($thing);
- no strict 'refs';
- $ioref = $thing if defined &{"${class}::TIEHANDLE"};
- }
- else {
- eval {
- $ioref = *{$thing}{IO};
- };
- undef $@;
- }
- if ($ioref) {
- return XML::SAX::PurePerl::Reader::Stream->new($thing)->init;
- }
-
- if ($thing =~ /</) {
- # assume it's a string
- return XML::SAX::PurePerl::Reader::String->new($thing)->init;
- }
-
- # assume it is a uri
- return XML::SAX::PurePerl::Reader::URI->new($thing)->init;
-}
-
-sub init {
- my $self = shift;
- $self->[LINE] = 1;
- $self->[COLUMN] = 1;
- $self->read_more;
- return $self;
-}
-
-sub data {
- my ($self, $min_length) = (@_, 1);
- if (length($self->[BUFFER]) < $min_length) {
- $self->read_more;
- }
- return $self->[BUFFER];
-}
-
-sub match {
- my ($self, $char) = @_;
- my $data = $self->data;
- if (substr($data, 0, 1) eq $char) {
- $self->move_along(1);
- return 1;
- }
- return 0;
-}
-
-sub public_id {
- my $self = shift;
- @_ and $self->[PUBLIC_ID] = shift;
- $self->[PUBLIC_ID];
-}
-
-sub system_id {
- my $self = shift;
- @_ and $self->[SYSTEM_ID] = shift;
- $self->[SYSTEM_ID];
-}
-
-sub line {
- shift->[LINE];
-}
-
-sub column {
- shift->[COLUMN];
-}
-
-sub get_encoding {
- my $self = shift;
- return $self->[ENCODING];
-}
-
-sub get_xml_version {
- my $self = shift;
- return $self->[XML_VERSION];
-}
-
-1;
-
-__END__
-
-=head1 NAME
-
-XML::Parser::PurePerl::Reader - Abstract Reader factory class
-
-=cut
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/XML/SAX/PurePerl/Reader/NoUnicodeExt.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/XML/SAX/PurePerl/Reader/NoUnicodeExt.pm
deleted file mode 100644
index b1ac49cf1d0..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/XML/SAX/PurePerl/Reader/NoUnicodeExt.pm
+++ /dev/null
@@ -1,25 +0,0 @@
-# $Id: NoUnicodeExt.pm,v 1.3 2003/07/30 13:39:23 matt Exp $
-
-package XML::SAX::PurePerl::Reader;
-use strict;
-
-sub set_raw_stream {
- # no-op
-}
-
-sub switch_encoding_stream {
- my ($fh, $encoding) = @_;
- throw XML::SAX::Exception::Parse (
- Message => "Only ASCII encoding allowed without perl 5.7.2 or higher. You tried: $encoding",
- ) if $encoding !~ /(ASCII|UTF\-?8)/i;
-}
-
-sub switch_encoding_string {
- my (undef, $encoding) = @_;
- throw XML::SAX::Exception::Parse (
- Message => "Only ASCII encoding allowed without perl 5.7.2 or higher. You tried: $encoding",
- ) if $encoding !~ /(ASCII|UTF\-?8)/i;
-}
-
-1;
-
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/XML/SAX/PurePerl/Reader/Stream.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/XML/SAX/PurePerl/Reader/Stream.pm
deleted file mode 100644
index 58b27587703..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/XML/SAX/PurePerl/Reader/Stream.pm
+++ /dev/null
@@ -1,84 +0,0 @@
-# $Id: Stream.pm,v 1.7 2005/10/14 20:31:20 matt Exp $
-
-package XML::SAX::PurePerl::Reader::Stream;
-
-use strict;
-use vars qw(@ISA);
-
-use XML::SAX::PurePerl::Reader qw(
- EOF
- BUFFER
- LINE
- COLUMN
- ENCODING
- XML_VERSION
-);
-use XML::SAX::Exception;
-
-@ISA = ('XML::SAX::PurePerl::Reader');
-
-# subclassed by adding 1 to last element
-use constant FH => 8;
-use constant BUFFER_SIZE => 4096;
-
-sub new {
- my $class = shift;
- my $ioref = shift;
- XML::SAX::PurePerl::Reader::set_raw_stream($ioref);
- my @parts;
- @parts[FH, LINE, COLUMN, BUFFER, EOF, XML_VERSION] =
- ($ioref, 1, 0, '', 0, '1.0');
- return bless \@parts, $class;
-}
-
-sub read_more {
- my $self = shift;
- my $buf;
- my $bytesread = read($self->[FH], $buf, BUFFER_SIZE);
- if ($bytesread) {
- $self->[BUFFER] .= $buf;
- return 1;
- }
- elsif (defined($bytesread)) {
- $self->[EOF]++;
- return 0;
- }
- else {
- throw XML::SAX::Exception::Parse(
- Message => "Error reading from filehandle: $!",
- );
- }
-}
-
-sub move_along {
- my $self = shift;
- my $discarded = substr($self->[BUFFER], 0, $_[0], '');
-
- # Wish I could skip this lot - tells us where we are in the file
- my $lines = $discarded =~ tr/\n//;
- $self->[LINE] += $lines;
- if ($lines) {
- $discarded =~ /\n([^\n]*)$/;
- $self->[COLUMN] = length($1);
- }
- else {
- $self->[COLUMN] += $_[0];
- }
-}
-
-sub set_encoding {
- my $self = shift;
- my ($encoding) = @_;
- # warn("set encoding to: $encoding\n");
- XML::SAX::PurePerl::Reader::switch_encoding_stream($self->[FH], $encoding);
- XML::SAX::PurePerl::Reader::switch_encoding_string($self->[BUFFER], $encoding);
- $self->[ENCODING] = $encoding;
-}
-
-sub bytepos {
- my $self = shift;
- tell($self->[FH]);
-}
-
-1;
-
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/XML/SAX/PurePerl/Reader/String.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/XML/SAX/PurePerl/Reader/String.pm
deleted file mode 100644
index fa3b227dffa..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/XML/SAX/PurePerl/Reader/String.pm
+++ /dev/null
@@ -1,61 +0,0 @@
-# $Id: String.pm,v 1.5 2003/07/30 13:39:23 matt Exp $
-
-package XML::SAX::PurePerl::Reader::String;
-
-use strict;
-use vars qw(@ISA);
-
-use XML::SAX::PurePerl::Reader qw(
- LINE
- COLUMN
- BUFFER
- ENCODING
- EOF
-);
-
-@ISA = ('XML::SAX::PurePerl::Reader');
-
-use constant DISCARDED => 7;
-
-sub new {
- my $class = shift;
- my $string = shift;
- my @parts;
- @parts[BUFFER, EOF, LINE, COLUMN, DISCARDED] =
- ($string, 0, 1, 0, '');
- return bless \@parts, $class;
-}
-
-sub read_more () { }
-
-sub move_along {
- my $self = shift;
- my $discarded = substr($self->[BUFFER], 0, $_[0], '');
- $self->[DISCARDED] .= $discarded;
-
- # Wish I could skip this lot - tells us where we are in the file
- my $lines = $discarded =~ tr/\n//;
- $self->[LINE] += $lines;
- if ($lines) {
- $discarded =~ /\n([^\n]*)$/;
- $self->[COLUMN] = length($1);
- }
- else {
- $self->[COLUMN] += $_[0];
- }
-}
-
-sub set_encoding {
- my $self = shift;
- my ($encoding) = @_;
-
- XML::SAX::PurePerl::Reader::switch_encoding_string($self->[BUFFER], $encoding, "utf-8");
- $self->[ENCODING] = $encoding;
-}
-
-sub bytepos {
- my $self = shift;
- length($self->[DISCARDED]);
-}
-
-1;
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/XML/SAX/PurePerl/Reader/URI.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/XML/SAX/PurePerl/Reader/URI.pm
deleted file mode 100644
index 1e63dba62b5..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/XML/SAX/PurePerl/Reader/URI.pm
+++ /dev/null
@@ -1,57 +0,0 @@
-# $Id: URI.pm,v 1.1 2001/11/11 18:41:51 matt Exp $
-
-package XML::SAX::PurePerl::Reader::URI;
-
-use strict;
-
-use XML::SAX::PurePerl::Reader;
-use File::Temp qw(tempfile);
-use Symbol;
-
-## NOTE: This is *not* a subclass of Reader. It just returns Stream or String
-## Reader objects depending on what it's capabilities are.
-
-sub new {
- my $class = shift;
- my $uri = shift;
- # request the URI
- if (-e $uri && -f _) {
- my $fh = gensym;
- open($fh, $uri) || die "Cannot open file $uri : $!";
- return XML::SAX::PurePerl::Reader::Stream->new($fh);
- }
- elsif ($uri =~ /^file:(.*)$/ && -e $1 && -f _) {
- my $file = $1;
- my $fh = gensym;
- open($fh, $file) || die "Cannot open file $file : $!";
- return XML::SAX::PurePerl::Reader::Stream->new($fh);
- }
- else {
- # request URI, return String reader
- require LWP::UserAgent;
- my $ua = LWP::UserAgent->new;
- $ua->agent("Perl/XML/SAX/PurePerl/1.0 " . $ua->agent);
-
- my $req = HTTP::Request->new(GET => $uri);
-
- my $fh = tempfile();
-
- my $callback = sub {
- my ($data, $response, $protocol) = @_;
- print $fh $data;
- };
-
- my $res = $ua->request($req, $callback, 4096);
-
- if ($res->is_success) {
- seek($fh, 0, 0);
- return XML::SAX::PurePerl::Reader::Stream->new($fh);
- }
- else {
- die "LWP Request Failed";
- }
- }
-}
-
-
-1;
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/XML/SAX/PurePerl/Reader/UnicodeExt.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/XML/SAX/PurePerl/Reader/UnicodeExt.pm
deleted file mode 100644
index 717f4b36336..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/XML/SAX/PurePerl/Reader/UnicodeExt.pm
+++ /dev/null
@@ -1,23 +0,0 @@
-# $Id: UnicodeExt.pm,v 1.4 2003/07/30 13:39:23 matt Exp $
-
-package XML::SAX::PurePerl::Reader;
-use strict;
-
-use Encode;
-
-sub set_raw_stream {
- my ($fh) = @_;
- binmode($fh, ":bytes");
-}
-
-sub switch_encoding_stream {
- my ($fh, $encoding) = @_;
- binmode($fh, ":encoding($encoding)");
-}
-
-sub switch_encoding_string {
- Encode::from_to($_[0], $_[1], "utf-8");
-}
-
-1;
-
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/XML/SAX/PurePerl/UnicodeExt.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/XML/SAX/PurePerl/UnicodeExt.pm
deleted file mode 100644
index 224b7bbff84..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/XML/SAX/PurePerl/UnicodeExt.pm
+++ /dev/null
@@ -1,22 +0,0 @@
-# $Id: UnicodeExt.pm,v 1.1 2002/01/30 17:35:21 matt Exp $
-
-package XML::SAX::PurePerl;
-use strict;
-
-no warnings 'utf8';
-
-sub chr_ref {
- return chr(shift);
-}
-
-if ($] >= 5.007002) {
- require Encode;
-
- Encode::define_alias( "UTF-16" => "UCS-2" );
- Encode::define_alias( "UTF-16BE" => "UCS-2" );
- Encode::define_alias( "UTF-16LE" => "ucs-2le" );
- Encode::define_alias( "UTF16LE" => "ucs-2le" );
-}
-
-1;
-
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/XML/SAX/PurePerl/XMLDecl.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/XML/SAX/PurePerl/XMLDecl.pm
deleted file mode 100644
index 17c6cc93b17..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/XML/SAX/PurePerl/XMLDecl.pm
+++ /dev/null
@@ -1,129 +0,0 @@
-# $Id: XMLDecl.pm,v 1.3 2003/07/30 13:39:22 matt Exp $
-
-package XML::SAX::PurePerl;
-
-use strict;
-use XML::SAX::PurePerl::Productions qw($S $VersionNum $EncNameStart $EncNameEnd);
-
-sub XMLDecl {
- my ($self, $reader) = @_;
-
- my $data = $reader->data(5);
- # warn("Looking for xmldecl in: $data");
- if ($data =~ /^<\?xml$S/o) {
- $reader->move_along(5);
- $self->skip_whitespace($reader);
-
- # get version attribute
- $self->VersionInfo($reader) ||
- $self->parser_error("XML Declaration lacks required version attribute, or version attribute does not match XML specification", $reader);
-
- if (!$self->skip_whitespace($reader)) {
- my $data = $reader->data(2);
- $data =~ /^\?>/ or $self->parser_error("Syntax error", $reader);
- $reader->move_along(2);
- return;
- }
-
- if ($self->EncodingDecl($reader)) {
- if (!$self->skip_whitespace($reader)) {
- my $data = $reader->data(2);
- $data =~ /^\?>/ or $self->parser_error("Syntax error", $reader);
- $reader->move_along(2);
- return;
- }
- }
-
- $self->SDDecl($reader);
-
- $self->skip_whitespace($reader);
-
- my $data = $reader->data(2);
- $data =~ /^\?>/ or $self->parser_error("Syntax error", $reader);
- $reader->move_along(2);
- }
- else {
- # warn("first 5 bytes: ", join(',', unpack("CCCCC", $data)), "\n");
- # no xml decl
- if (!$reader->get_encoding) {
- $reader->set_encoding("UTF-8");
- }
- }
-}
-
-sub VersionInfo {
- my ($self, $reader) = @_;
-
- my $data = $reader->data(11);
-
- # warn("Looking for version in $data");
-
- $data =~ /^(version$S*=$S*(["'])($VersionNum)\2)/o or return 0;
- $reader->move_along(length($1));
- my $vernum = $3;
-
- if ($vernum ne "1.0") {
- $self->parser_error("Only XML version 1.0 supported. Saw: '$vernum'", $reader);
- }
-
- return 1;
-}
-
-sub SDDecl {
- my ($self, $reader) = @_;
-
- my $data = $reader->data(15);
-
- $data =~ /^(standalone$S*=$S*(["'])(yes|no)\2)/o or return 0;
- $reader->move_along(length($1));
- my $yesno = $3;
-
- if ($yesno eq 'yes') {
- $self->{standalone} = 1;
- }
- else {
- $self->{standalone} = 0;
- }
-
- return 1;
-}
-
-sub EncodingDecl {
- my ($self, $reader) = @_;
-
- my $data = $reader->data(12);
-
- $data =~ /^(encoding$S*=$S*(["'])($EncNameStart$EncNameEnd*)\2)/o or return 0;
- $reader->move_along(length($1));
- my $encoding = $3;
-
- $reader->set_encoding($encoding);
-
- return 1;
-}
-
-sub TextDecl {
- my ($self, $reader) = @_;
-
- my $data = $reader->data(6);
- $data =~ /^<\?xml$S+/ or return;
- $reader->move_along(5);
- $self->skip_whitespace($reader);
-
- if ($self->VersionInfo($reader)) {
- $self->skip_whitespace($reader) ||
- $self->parser_error("Lack of whitespace after version attribute in text declaration", $reader);
- }
-
- $self->EncodingDecl($reader) ||
- $self->parser_error("Encoding declaration missing from external entity text declaration", $reader);
-
- $self->skip_whitespace($reader);
-
- $data = $reader->data(2);
- $data =~ /^\?>/ or $self->parser_error("Syntax error", $reader);
-
- return 1;
-}
-
-1;
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/XML/SAX/placeholder.pl b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/XML/SAX/placeholder.pl
deleted file mode 100644
index 6db59025607..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/XML/SAX/placeholder.pl
+++ /dev/null
@@ -1 +0,0 @@
-# ignore me
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/YAML.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/YAML.pm
deleted file mode 100644
index d886bf53ed7..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/YAML.pm
+++ /dev/null
@@ -1,788 +0,0 @@
-package YAML;
-use strict; use warnings;
-use YAML::Base;
-use base 'YAML::Base';
-use YAML::Node; # XXX This is a temp fix for Module::Build
-use 5.006001;
-our $VERSION = '0.66';
-our @EXPORT = qw'Dump Load';
-our @EXPORT_OK = qw'freeze thaw DumpFile LoadFile Bless Blessed';
-
-# XXX This VALUE nonsense needs to go.
-use constant VALUE => "\x07YAML\x07VALUE\x07";
-
-# YAML Object Properties
-field dumper_class => 'YAML::Dumper';
-field loader_class => 'YAML::Loader';
-field dumper_object =>
- -init => '$self->init_action_object("dumper")';
-field loader_object =>
- -init => '$self->init_action_object("loader")';
-
-sub Dump {
- my $yaml = YAML->new;
- $yaml->dumper_class($YAML::DumperClass)
- if $YAML::DumperClass;
- return $yaml->dumper_object->dump(@_);
-}
-
-sub Load {
- my $yaml = YAML->new;
- $yaml->loader_class($YAML::LoaderClass)
- if $YAML::LoaderClass;
- return $yaml->loader_object->load(@_);
-}
-
-{
- no warnings 'once';
- # freeze/thaw is the API for Storable string serialization. Some
- # modules make use of serializing packages on if they use freeze/thaw.
- *freeze = \ &Dump;
- *thaw = \ &Load;
-}
-
-sub DumpFile {
- my $OUT;
- my $filename = shift;
- if (ref $filename eq 'GLOB') {
- $OUT = $filename;
- }
- else {
- my $mode = '>';
- if ($filename =~ /^\s*(>{1,2})\s*(.*)$/) {
- ($mode, $filename) = ($1, $2);
- }
- open $OUT, $mode, $filename
- or YAML::Base->die('YAML_DUMP_ERR_FILE_OUTPUT', $filename, $!);
- }
- local $/ = "\n"; # reset special to "sane"
- print $OUT Dump(@_);
-}
-
-sub LoadFile {
- my $IN;
- my $filename = shift;
- if (ref $filename eq 'GLOB') {
- $IN = $filename;
- }
- else {
- open $IN, $filename
- or YAML::Base->die('YAML_LOAD_ERR_FILE_INPUT', $filename, $!);
- }
- return Load(do { local $/; <$IN> });
-}
-
-sub init_action_object {
- my $self = shift;
- my $object_class = (shift) . '_class';
- my $module_name = $self->$object_class;
- eval "require $module_name";
- $self->die("Error in require $module_name - $@")
- if $@ and "$@" !~ /Can't locate/;
- my $object = $self->$object_class->new;
- $object->set_global_options;
- return $object;
-}
-
-my $global = {};
-sub Bless {
- require YAML::Dumper::Base;
- YAML::Dumper::Base::bless($global, @_)
-}
-sub Blessed {
- require YAML::Dumper::Base;
- YAML::Dumper::Base::blessed($global, @_)
-}
-sub global_object { $global }
-
-1;
-
-__END__
-
-=head1 NAME
-
-YAML - YAML Ain't Markup Language (tm)
-
-=head1 SYNOPSIS
-
- use YAML;
-
- # Load a YAML stream of 3 YAML documents into Perl data structures.
- my ($hashref, $arrayref, $string) = Load(<<'...');
- ---
- name: ingy
- age: old
- weight: heavy
- # I should comment that I also like pink, but don't tell anybody.
- favorite colors:
- - red
- - green
- - blue
- ---
- - Clark Evans
- - Oren Ben-Kiki
- - Ingy döt Net
- --- >
- You probably think YAML stands for "Yet Another Markup Language". It
- ain't! YAML is really a data serialization language. But if you want
- to think of it as a markup, that's OK with me. A lot of people try
- to use XML as a serialization format.
-
- "YAML" is catchy and fun to say. Try it. "YAML, YAML, YAML!!!"
- ...
-
- # Dump the Perl data structures back into YAML.
- print Dump($string, $arrayref, $hashref);
-
- # YAML::Dump is used the same way you'd use Data::Dumper::Dumper
- use Data::Dumper;
- print Dumper($string, $arrayref, $hashref);
-
-=head1 DESCRIPTION
-
-The YAML.pm module implements a YAML Loader and Dumper based on the YAML
-1.0 specification. L<http://www.yaml.org/spec/>
-
-YAML is a generic data serialization language that is optimized for
-human readability. It can be used to express the data structures of most
-modern programming languages. (Including Perl!!!)
-
-For information on the YAML syntax, please refer to the YAML
-specification.
-
-=head1 WHY YAML IS COOL
-
-=over 4
-
-=item YAML is readable for people.
-
-It makes clear sense out of complex data structures. You should find
-that YAML is an exceptional data dumping tool. Structure is shown
-through indentation, YAML supports recursive data, and hash keys are
-sorted by default. In addition, YAML supports several styles of scalar
-formatting for different types of data.
-
-=item YAML is editable.
-
-YAML was designed from the ground up to be an excellent syntax for
-configuration files. Almost all programs need configuration files, so
-why invent a new syntax for each one? And why subject users to the
-complexities of XML or native Perl code?
-
-=item YAML is multilingual.
-
-Yes, YAML supports Unicode. But I'm actually referring to programming
-languages. YAML was designed to meet the serialization needs of Perl,
-Python, Ruby, Tcl, PHP, Javascript and Java. It was also designed to be
-interoperable between those languages. That means YAML serializations
-produced by Perl can be processed by Python.
-
-=item YAML is taint safe.
-
-Using modules like Data::Dumper for serialization is fine as long as you
-can be sure that nobody can tamper with your data files or
-transmissions. That's because you need to use Perl's C<eval()> built-in
-to deserialize the data. Somebody could add a snippet of Perl to erase
-your files.
-
-YAML's parser does not need to eval anything.
-
-=item YAML is full featured.
-
-YAML can accurately serialize all of the common Perl data structures and
-deserialize them again without losing data relationships. Although it is
-not 100% perfect (no serializer is or can be perfect), it fares as well
-as the popular current modules: Data::Dumper, Storable, XML::Dumper and
-Data::Denter.
-
-YAML.pm also has the ability to handle code (subroutine) references and
-typeglobs. (Still experimental) These features are not found in Perl's
-other serialization modules.
-
-=item YAML is extensible.
-
-The YAML language has been designed to be flexible enough to solve it's
-own problems. The markup itself has 3 basic construct which resemble
-Perl's hash, array and scalar. By default, these map to their Perl
-equivalents. But each YAML node also supports a tagging mechanism (type
-system) which can cause that node to be interpreted in a completely
-different manner. That's how YAML can support object serialization and
-oddball structures like Perl's typeglob.
-
-=back
-
-=head1 YAML IMPLEMENTATIONS IN PERL
-
-This module, YAML.pm, is really just the interface module for YAML
-modules written in Perl. The basic interface for YAML consists of two
-functions: C<Dump> and C<Load>. The real work is done by the modules
-YAML::Dumper and YAML::Loader.
-
-Different YAML module distributions can be created by subclassing
-YAML.pm and YAML::Loader and YAML::Dumper. For example, YAML-Simple
-consists of YAML::Simple YAML::Dumper::Simple and YAML::Loader::Simple.
-
-Why would there be more than one implementation of YAML? Well, despite
-YAML's offering of being a simple data format, YAML is actually very
-deep and complex. Implementing the entirety of the YAML specification is
-a daunting task.
-
-For this reason I am currently working on 3 different YAML implementations.
-
-=over
-
-=item YAML
-
-The main YAML distribution will keeping evolving to support the entire
-YAML specification in pure Perl. This may not be the fastest or most
-stable module though. Currently, YAML.pm has lots of known bugs. It is
-mostly a great tool for dumping Perl data structures to a readable form.
-
-=item YAML::Lite
-
-The point of YAML::Lite is to strip YAML down to the 90% that people
-use most and offer that in a small, fast, stable, pure Perl form.
-YAML::Lite will simply die when it is asked to do something it can't.
-
-=item YAML::Syck
-
-C<libsyck> is the C based YAML processing library used by the Ruby
-programming language (and also Python, PHP and Pugs). YAML::Syck is the
-Perl binding to C<libsyck>. It should be very fast, but may have
-problems of its own. It will also require C compilation.
-
-NOTE: Audrey Tang has actually completed this module and it works great
- and is 10 times faster than YAML.pm.
-
-=back
-
-In the future, there will likely be even more YAML modules. Remember,
-people other than Ingy are allowed to write YAML modules!
-
-=head1 FUNCTIONAL USAGE
-
-YAML is completely OO under the hood. Still it exports a few useful top
-level functions so that it is dead simple to use. These functions just
-do the OO stuff for you. If you want direct access to the OO API see the
-documentation for YAML::Dumper and YAML::Loader.
-
-=head2 Exported Functions
-
-The following functions are exported by YAML.pm by default. The reason
-they are exported is so that YAML works much like Data::Dumper. If you
-don't want functions to be imported, just use YAML with an empty
-import list:
-
- use YAML ();
-
-=over 4
-
-=item Dump(list-of-Perl-data-structures)
-
-Turn Perl data into YAML. This function works very much like
-Data::Dumper::Dumper(). It takes a list of Perl data strucures and
-dumps them into a serialized form. It returns a string containing the
-YAML stream. The structures can be references or plain scalars.
-
-=item Load(string-containing-a-YAML-stream)
-
-Turn YAML into Perl data. This is the opposite of Dump. Just like
-Storable's thaw() function or the eval() function in relation to
-Data::Dumper. It parses a string containing a valid YAML stream into a
-list of Perl data structures.
-
-=back
-
-=head2 Exportable Functions
-
-These functions are not exported by default but you can request them in
-an import list like this:
-
- use YAML qw'freeze thaw Bless';
-
-=over 4
-
-=item freeze() and thaw()
-
-Aliases to Dump() and Load() for Storable fans. This will also allow
-YAML.pm to be plugged directly into modules like POE.pm, that use the
-freeze/thaw API for internal serialization.
-
-=item DumpFile(filepath, list)
-
-Writes the YAML stream to a file instead of just returning a string.
-
-=item LoadFile(filepath)
-
-Reads the YAML stream from a file instead of a string.
-
-=item Bless(perl-node, [yaml-node | class-name])
-
-Associate a normal Perl node, with a yaml node. A yaml node is an object
-tied to the YAML::Node class. The second argument is either a yaml node
-that you've already created or a class (package) name that supports a
-yaml_dump() function. A yaml_dump() function should take a perl node and
-return a yaml node. If no second argument is provided, Bless will create
-a yaml node. This node is not returned, but can be retrieved with the
-Blessed() function.
-
-Here's an example of how to use Bless. Say you have a hash containing
-three keys, but you only want to dump two of them. Furthermore the keys
-must be dumped in a certain order. Here's how you do that:
-
- use YAML qw(Dump Bless);
- $hash = {apple => 'good', banana => 'bad', cauliflower => 'ugly'};
- print Dump $hash;
- Bless($hash)->keys(['banana', 'apple']);
- print Dump $hash;
-
-produces:
-
- ---
- apple: good
- banana: bad
- cauliflower: ugly
- ---
- banana: bad
- apple: good
-
-Bless returns the tied part of a yaml-node, so that you can call the
-YAML::Node methods. This is the same thing that YAML::Node::ynode()
-returns. So another way to do the above example is:
-
- use YAML qw(Dump Bless);
- use YAML::Node;
- $hash = {apple => 'good', banana => 'bad', cauliflower => 'ugly'};
- print Dump $hash;
- Bless($hash);
- $ynode = ynode(Blessed($hash));
- $ynode->keys(['banana', 'apple']);
- print Dump $hash;
-
-Note that Blessing a Perl data structure does not change it anyway. The
-extra information is stored separately and looked up by the Blessed
-node's memory address.
-
-=item Blessed(perl-node)
-
-Returns the yaml node that a particular perl node is associated with
-(see above). Returns undef if the node is not (YAML) Blessed.
-
-=back
-
-=head1 GLOBAL OPTIONS
-
-YAML options are set using a group of global variables in the YAML
-namespace. This is similar to how Data::Dumper works.
-
-For example, to change the indentation width, do something like:
-
- local $YAML::Indent = 3;
-
-The current options are:
-
-=over 4
-
-=item DumperClass
-
-You can override which module/class YAML uses for Dumping data.
-
-=item LoaderClass
-
-You can override which module/class YAML uses for Loading data.
-
-=item Indent
-
-This is the number of space characters to use for each indentation level
-when doing a Dump(). The default is 2.
-
-By the way, YAML can use any number of characters for indentation at any
-level. So if you are editing YAML by hand feel free to do it anyway that
-looks pleasing to you; just be consistent for a given level.
-
-=item SortKeys
-
-Default is 1. (true)
-
-Tells YAML.pm whether or not to sort hash keys when storing a document.
-
-YAML::Node objects can have their own sort order, which is usually what
-you want. To override the YAML::Node order and sort the keys anyway, set
-SortKeys to 2.
-
-=item Stringify
-
-Default is 0. (false)
-
-Objects with string overloading should honor the overloading and dump the
-stringification of themselves, rather than the actual object's guts.
-
-=item UseHeader
-
-Default is 1. (true)
-
-This tells YAML.pm whether to use a separator string for a Dump
-operation. This only applies to the first document in a stream.
-Subsequent documents must have a YAML header by definition.
-
-=item UseVersion
-
-Default is 0. (false)
-
-Tells YAML.pm whether to include the YAML version on the
-separator/header.
-
- --- %YAML:1.0
-
-=item AnchorPrefix
-
-Default is ''.
-
-Anchor names are normally numeric. YAML.pm simply starts with '1' and
-increases by one for each new anchor. This option allows you to specify a
-string to be prepended to each anchor number.
-
-=item UseCode
-
-Setting the UseCode option is a shortcut to set both the DumpCode and
-LoadCode options at once. Setting UseCode to '1' tells YAML.pm to dump
-Perl code references as Perl (using B::Deparse) and to load them back
-into memory using eval(). The reason this has to be an option is that
-using eval() to parse untrusted code is, well, untrustworthy.
-
-=item DumpCode
-
-Determines if and how YAML.pm should serialize Perl code references. By
-default YAML.pm will dump code references as dummy placeholders (much
-like Data::Dumper). If DumpCode is set to '1' or 'deparse', code
-references will be dumped as actual Perl code.
-
-DumpCode can also be set to a subroutine reference so that you can
-write your own serializing routine. YAML.pm passes you the code ref. You
-pass back the serialization (as a string) and a format indicator. The
-format indicator is a simple string like: 'deparse' or 'bytecode'.
-
-=item LoadCode
-
-LoadCode is the opposite of DumpCode. It tells YAML if and how to
-deserialize code references. When set to '1' or 'deparse' it will use
-C<eval()>. Since this is potentially risky, only use this option if you
-know where your YAML has been.
-
-LoadCode can also be set to a subroutine reference so that you can write
-your own deserializing routine. YAML.pm passes the serialization (as a
-string) and a format indicator. You pass back the code reference.
-
-=item UseBlock
-
-YAML.pm uses heuristics to guess which scalar style is best for a given
-node. Sometimes you'll want all multiline scalars to use the 'block'
-style. If so, set this option to 1.
-
-NOTE: YAML's block style is akin to Perl's here-document.
-
-=item UseFold
-
-If you want to force YAML to use the 'folded' style for all multiline
-scalars, then set $UseFold to 1.
-
-NOTE: YAML's folded style is akin to the way HTML folds text,
- except smarter.
-
-=item UseAliases
-
-YAML has an alias mechanism such that any given structure in memory gets
-serialized once. Any other references to that structure are serialized
-only as alias markers. This is how YAML can serialize duplicate and
-recursive structures.
-
-Sometimes, when you KNOW that your data is nonrecursive in nature, you
-may want to serialize such that every node is expressed in full. (ie as
-a copy of the original). Setting $YAML::UseAliases to 0 will allow you
-to do this. This also may result in faster processing because the lookup
-overhead is by bypassed.
-
-THIS OPTION CAN BE DANGEROUS. *If* your data is recursive, this option
-*will* cause Dump() to run in an endless loop, chewing up your computers
-memory. You have been warned.
-
-=item CompressSeries
-
-Default is 1.
-
-Compresses the formatting of arrays of hashes:
-
- -
- foo: bar
- -
- bar: foo
-
-becomes:
-
- - foo: bar
- - bar: foo
-
-Since this output is usually more desirable, this option is turned on by
-default.
-
-=back
-
-=head1 YAML TERMINOLOGY
-
-YAML is a full featured data serialization language, and thus has its
-own terminology.
-
-It is important to remember that although YAML is heavily influenced by
-Perl and Python, it is a language in its own right, not merely just a
-representation of Perl structures.
-
-YAML has three constructs that are conspicuously similar to Perl's hash,
-array, and scalar. They are called mapping, sequence, and string
-respectively. By default, they do what you would expect. But each
-instance may have an explicit or implicit tag (type) that makes it
-behave differently. In this manner, YAML can be extended to represent
-Perl's Glob or Python's tuple, or Ruby's Bigint.
-
-=over 4
-
-=item stream
-
-A YAML stream is the full sequence of unicode characters that a YAML
-parser would read or a YAML emitter would write. A stream may contain
-one or more YAML documents separated by YAML headers.
-
- ---
- a: mapping
- foo: bar
- ---
- - a
- - sequence
-
-=item document
-
-A YAML document is an independent data structure representation within a
-stream. It is a top level node. Each document in a YAML stream must
-begin with a YAML header line. Actually the header is optional on the
-first document.
-
- ---
- This: top level mapping
- is:
- - a
- - YAML
- - document
-
-=item header
-
-A YAML header is a line that begins a YAML document. It consists of
-three dashes, possibly followed by more info. Another purpose of the
-header line is that it serves as a place to put top level tag and anchor
-information.
-
- --- !recursive-sequence &001
- - * 001
- - * 001
-
-=item node
-
-A YAML node is the representation of a particular data stucture. Nodes
-may contain other nodes. (In Perl terms, nodes are like scalars.
-Strings, arrayrefs and hashrefs. But this refers to the serialized
-format, not the in-memory structure.)
-
-=item tag
-
-This is similar to a type. It indicates how a particular YAML node
-serialization should be transferred into or out of memory. For instance
-a Foo::Bar object would use the tag 'perl/Foo::Bar':
-
- - !perl/Foo::Bar
- foo: 42
- bar: stool
-
-=item collection
-
-A collection is the generic term for a YAML data grouping. YAML has two
-types of collections: mappings and sequences. (Similar to hashes and arrays)
-
-=item mapping
-
-A mapping is a YAML collection defined by unordered key/value pairs with
-unique keys. By default YAML mappings are loaded into Perl hashes.
-
- a mapping:
- foo: bar
- two: times two is 4
-
-=item sequence
-
-A sequence is a YAML collection defined by an ordered list of elements. By
-default YAML sequences are loaded into Perl arrays.
-
- a sequence:
- - one bourbon
- - one scotch
- - one beer
-
-=item scalar
-
-A scalar is a YAML node that is a single value. By default YAML scalars
-are loaded into Perl scalars.
-
- a scalar key: a scalar value
-
-YAML has many styles for representing scalars. This is important because
-varying data will have varying formatting requirements to retain the
-optimum human readability.
-
-=item plain scalar
-
-A plain sclar is unquoted. All plain scalars are automatic candidates
-for "implicit tagging". This means that their tag may be determined
-automatically by examination. The typical uses for this are plain alpha
-strings, integers, real numbers, dates, times and currency.
-
- - a plain string
- - -42
- - 3.1415
- - 12:34
- - 123 this is an error
-
-=item single quoted scalar
-
-This is similar to Perl's use of single quotes. It means no escaping
-except for single quotes which are escaped by using two adjacent
-single quotes.
-
- - 'When I say ''\n'' I mean "backslash en"'
-
-=item double quoted scalar
-
-This is similar to Perl's use of double quotes. Character escaping can
-be used.
-
- - "This scalar\nhas two lines, and a bell -->\a"
-
-=item folded scalar
-
-This is a multiline scalar which begins on the next line. It is
-indicated by a single right angle bracket. It is unescaped like the
-single quoted scalar. Line folding is also performed.
-
- - >
- This is a multiline scalar which begins on
- the next line. It is indicated by a single
- carat. It is unescaped like the single
- quoted scalar. Line folding is also
- performed.
-
-=item block scalar
-
-This final multiline form is akin to Perl's here-document except that
-(as in all YAML data) scope is indicated by indentation. Therefore, no
-ending marker is required. The data is verbatim. No line folding.
-
- - |
- QTY DESC PRICE TOTAL
- --- ---- ----- -----
- 1 Foo Fighters $19.95 $19.95
- 2 Bar Belles $29.95 $59.90
-
-=item parser
-
-A YAML processor has four stages: parse, load, dump, emit.
-
-A parser parses a YAML stream. YAML.pm's Load() function contains a
-parser.
-
-=item loader
-
-The other half of the Load() function is a loader. This takes the
-information from the parser and loads it into a Perl data structure.
-
-=item dumper
-
-The Dump() function consists of a dumper and an emitter. The dumper
-walks through each Perl data structure and gives info to the emitter.
-
-=item emitter
-
-The emitter takes info from the dumper and turns it into a YAML stream.
-
-NOTE:
-In YAML.pm the parser/loader and the dumper/emitter code are currently
-very closely tied together. In the future they may be broken into
-separate stages.
-
-=back
-
-For more information please refer to the immensely helpful YAML
-specification available at L<http://www.yaml.org/spec/>.
-
-=head1 ysh - The YAML Shell
-
-The YAML distribution ships with a script called 'ysh', the YAML shell.
-ysh provides a simple, interactive way to play with YAML. If you type in
-Perl code, it displays the result in YAML. If you type in YAML it turns
-it into Perl code.
-
-To run ysh, (assuming you installed it along with YAML.pm) simply type:
-
- ysh [options]
-
-Please read the C<ysh> documentation for the full details. There are
-lots of options.
-
-=head1 BUGS & DEFICIENCIES
-
-If you find a bug in YAML, please try to recreate it in the YAML Shell
-with logging turned on ('ysh -L'). When you have successfully reproduced
-the bug, please mail the LOG file to the author (ingy@cpan.org).
-
-WARNING: This is still *ALPHA* code. Well, most of this code has been
-around for years...
-
-BIGGER WARNING: YAML.pm has been slow in the making, but I am committed
-to having top notch YAML tools in the Perl world. The YAML team is close
-to finalizing the YAML 1.1 spec. This version of YAML.pm is based off of
-a very old pre 1.0 spec. In actuality there isn't a ton of difference,
-and this YAML.pm is still fairly useful. Things will get much better in
-the future.
-
-=head1 RESOURCES
-
-L<http://lists.sourceforge.net/lists/listinfo/yaml-core> is the mailing
-list. This is where the language is discussed and designed.
-
-L<http://www.yaml.org> is the official YAML website.
-
-L<http://www.yaml.org/spec/> is the YAML 1.0 specification.
-
-L<http://yaml.kwiki.org> is the official YAML wiki.
-
-=head1 SEE ALSO
-
-See YAML::Syck. Fast!
-
-=head1 AUTHOR
-
-Ingy döt Net <ingy@cpan.org>
-
-is resonsible for YAML.pm.
-
-The YAML serialization language is the result of years of collaboration
-between Oren Ben-Kiki, Clark Evans and Ingy döt Net. Several others
-have added help along the way.
-
-=head1 COPYRIGHT
-
-Copyright (c) 2005, 2006. Ingy döt Net. All rights reserved.
-
-Copyright (c) 2001, 2002, 2005. Brian Ingerson. All rights reserved.
-
-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/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/YAML/Base.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/YAML/Base.pm
deleted file mode 100644
index f97f28660cc..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/YAML/Base.pm
+++ /dev/null
@@ -1,200 +0,0 @@
-package YAML::Base;
-use strict; use warnings;
-use base 'Exporter';
-
-our @EXPORT = qw(field XXX);
-
-sub new {
- my $class = shift;
- $class = ref($class) || $class;
- my $self = bless {}, $class;
- while (@_) {
- my $method = shift;
- $self->$method(shift);
- }
- return $self;
-}
-
-# Use lexical subs to reduce pollution of private methods by base class.
-my ($_new_error, $_info, $_scalar_info, $parse_arguments, $default_as_code);
-
-sub XXX {
- require Data::Dumper;
- CORE::die(Data::Dumper::Dumper(@_));
-}
-
-my %code = (
- sub_start =>
- "sub {\n",
- set_default =>
- " \$_[0]->{%s} = %s\n unless exists \$_[0]->{%s};\n",
- init =>
- " return \$_[0]->{%s} = do { my \$self = \$_[0]; %s }\n" .
- " unless \$#_ > 0 or defined \$_[0]->{%s};\n",
- return_if_get =>
- " return \$_[0]->{%s} unless \$#_ > 0;\n",
- set =>
- " \$_[0]->{%s} = \$_[1];\n",
- sub_end =>
- " return \$_[0]->{%s};\n}\n",
-);
-
-sub field {
- my $package = caller;
- my ($args, @values) = &$parse_arguments(
- [ qw(-package -init) ],
- @_,
- );
- my ($field, $default) = @values;
- $package = $args->{-package} if defined $args->{-package};
- return if defined &{"${package}::$field"};
- my $default_string =
- ( ref($default) eq 'ARRAY' and not @$default )
- ? '[]'
- : (ref($default) eq 'HASH' and not keys %$default )
- ? '{}'
- : &$default_as_code($default);
-
- my $code = $code{sub_start};
- if ($args->{-init}) {
- my $fragment = $code{init};
- $code .= sprintf $fragment, $field, $args->{-init}, ($field) x 4;
- }
- $code .= sprintf $code{set_default}, $field, $default_string, $field
- if defined $default;
- $code .= sprintf $code{return_if_get}, $field;
- $code .= sprintf $code{set}, $field;
- $code .= sprintf $code{sub_end}, $field;
-
- my $sub = eval $code;
- die $@ if $@;
- no strict 'refs';
- *{"${package}::$field"} = $sub;
- return $code if defined wantarray;
-}
-
-sub die {
- my $self = shift;
- my $error = $self->$_new_error(@_);
- $error->type('Error');
- Carp::croak($error->format_message);
-}
-
-sub warn {
- my $self = shift;
- return unless $^W;
- my $error = $self->$_new_error(@_);
- $error->type('Warning');
- Carp::cluck($error->format_message);
-}
-
-# This code needs to be refactored to be simpler and more precise, and no,
-# Scalar::Util doesn't DWIM.
-#
-# Can't handle:
-# * blessed regexp
-sub node_info {
- my $self = shift;
- my $stringify = $_[1] || 0;
- my ($class, $type, $id) =
- ref($_[0])
- ? $stringify
- ? &$_info("$_[0]")
- : do {
- require overload;
- my @info = &$_info(overload::StrVal($_[0]));
- if (ref($_[0]) eq 'Regexp') {
- @info[0, 1] = (undef, 'REGEXP');
- }
- @info;
- }
- : &$_scalar_info($_[0]);
- ($class, $type, $id) = &$_scalar_info("$_[0]")
- unless $id;
- return wantarray ? ($class, $type, $id) : $id;
-}
-
-#-------------------------------------------------------------------------------
-$_info = sub {
- return (($_[0]) =~ qr{^(?:(.*)\=)?([^=]*)\(([^\(]*)\)$}o);
-};
-
-$_scalar_info = sub {
- my $id = 'undef';
- if (defined $_[0]) {
- \$_[0] =~ /\((\w+)\)$/o or CORE::die();
- $id = "$1-S";
- }
- return (undef, undef, $id);
-};
-
-$_new_error = sub {
- require Carp;
- my $self = shift;
- require YAML::Error;
-
- my $code = shift || 'unknown error';
- my $error = YAML::Error->new(code => $code);
- $error->line($self->line) if $self->can('line');
- $error->document($self->document) if $self->can('document');
- $error->arguments([@_]);
- return $error;
-};
-
-$parse_arguments = sub {
- my $paired_arguments = shift || [];
- my ($args, @values) = ({}, ());
- my %pairs = map { ($_, 1) } @$paired_arguments;
- while (@_) {
- my $elem = shift;
- if (defined $elem and defined $pairs{$elem} and @_) {
- $args->{$elem} = shift;
- }
- else {
- push @values, $elem;
- }
- }
- return wantarray ? ($args, @values) : $args;
-};
-
-$default_as_code = sub {
- no warnings 'once';
- require Data::Dumper;
- local $Data::Dumper::Sortkeys = 1;
- my $code = Data::Dumper::Dumper(shift);
- $code =~ s/^\$VAR1 = //;
- $code =~ s/;$//;
- return $code;
-};
-
-1;
-
-__END__
-
-=head1 NAME
-
-YAML::Base - Base class for YAML classes
-
-=head1 SYNOPSIS
-
- package YAML::Something;
- use YAML::Base -base;
-
-=head1 DESCRIPTION
-
-YAML::Base is the parent of all YAML classes.
-
-=head1 AUTHOR
-
-Ingy döt Net <ingy@cpan.org>
-
-=head1 COPYRIGHT
-
-Copyright (c) 2006. Ingy döt Net. All rights reserved.
-
-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/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/YAML/Dumper.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/YAML/Dumper.pm
deleted file mode 100644
index 937729f97fd..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/YAML/Dumper.pm
+++ /dev/null
@@ -1,587 +0,0 @@
-package YAML::Dumper;
-use strict; use warnings;
-use YAML::Base;
-use base 'YAML::Dumper::Base';
-
-use YAML::Node;
-use YAML::Types;
-
-# Context constants
-use constant KEY => 3;
-use constant BLESSED => 4;
-use constant FROMARRAY => 5;
-use constant VALUE => "\x07YAML\x07VALUE\x07";
-
-# Common YAML character sets
-my $ESCAPE_CHAR = '[\\x00-\\x08\\x0b-\\x0d\\x0e-\\x1f]';
-my $LIT_CHAR = '|';
-
-#==============================================================================
-# OO version of Dump. YAML->new->dump($foo);
-sub dump {
- my $self = shift;
- $self->stream('');
- $self->document(0);
- for my $document (@_) {
- $self->{document}++;
- $self->transferred({});
- $self->id_refcnt({});
- $self->id_anchor({});
- $self->anchor(1);
- $self->level(0);
- $self->offset->[0] = 0 - $self->indent_width;
- $self->_prewalk($document);
- $self->_emit_header($document);
- $self->_emit_node($document);
- }
- return $self->stream;
-}
-
-# Every YAML document in the stream must begin with a YAML header, unless
-# there is only a single document and the user requests "no header".
-sub _emit_header {
- my $self = shift;
- my ($node) = @_;
- if (not $self->use_header and
- $self->document == 1
- ) {
- $self->die('YAML_DUMP_ERR_NO_HEADER')
- unless ref($node) =~ /^(HASH|ARRAY)$/;
- $self->die('YAML_DUMP_ERR_NO_HEADER')
- if ref($node) eq 'HASH' and keys(%$node) == 0;
- $self->die('YAML_DUMP_ERR_NO_HEADER')
- if ref($node) eq 'ARRAY' and @$node == 0;
- # XXX Also croak if aliased, blessed, or ynode
- $self->headless(1);
- return;
- }
- $self->{stream} .= '---';
-# XXX Consider switching to 1.1 style
- if ($self->use_version) {
-# $self->{stream} .= " #YAML:1.0";
- }
-}
-
-# Walk the tree to be dumped and keep track of its reference counts.
-# This function is where the Dumper does all its work. All type
-# transfers happen here.
-sub _prewalk {
- my $self = shift;
- my $stringify = $self->stringify;
- my ($class, $type, $node_id) = $self->node_info(\$_[0], $stringify);
-
- # Handle typeglobs
- if ($type eq 'GLOB') {
- $self->transferred->{$node_id} =
- YAML::Type::glob->yaml_dump($_[0]);
- $self->_prewalk($self->transferred->{$node_id});
- return;
- }
-
- # Handle regexps
- if (ref($_[0]) eq 'Regexp') {
- return;
- }
-
- # Handle Purity for scalars.
- # XXX can't find a use case yet. Might be YAGNI.
- if (not ref $_[0]) {
- $self->{id_refcnt}{$node_id}++ if $self->purity;
- return;
- }
-
- # Make a copy of original
- my $value = $_[0];
- ($class, $type, $node_id) = $self->node_info($value, $stringify);
-
- # Must be a stringified object.
- return if (ref($value) and not $type);
-
- # Look for things already transferred.
- if ($self->transferred->{$node_id}) {
- (undef, undef, $node_id) = (ref $self->transferred->{$node_id})
- ? $self->node_info($self->transferred->{$node_id}, $stringify)
- : $self->node_info(\ $self->transferred->{$node_id}, $stringify);
- $self->{id_refcnt}{$node_id}++;
- return;
- }
-
- # Handle code refs
- if ($type eq 'CODE') {
- $self->transferred->{$node_id} = 'placeholder';
- YAML::Type::code->yaml_dump(
- $self->dump_code,
- $_[0],
- $self->transferred->{$node_id}
- );
- ($class, $type, $node_id) =
- $self->node_info(\ $self->transferred->{$node_id}, $stringify);
- $self->{id_refcnt}{$node_id}++;
- return;
- }
-
- # Handle blessed things
- if (defined $class) {
- if ($value->can('yaml_dump')) {
- $value = $value->yaml_dump;
- }
- elsif ($type eq 'SCALAR') {
- $self->transferred->{$node_id} = 'placeholder';
- YAML::Type::blessed->yaml_dump
- ($_[0], $self->transferred->{$node_id});
- ($class, $type, $node_id) =
- $self->node_info(\ $self->transferred->{$node_id}, $stringify);
- $self->{id_refcnt}{$node_id}++;
- return;
- }
- else {
- $value = YAML::Type::blessed->yaml_dump($value);
- }
- $self->transferred->{$node_id} = $value;
- (undef, $type, $node_id) = $self->node_info($value, $stringify);
- }
-
- # Handle YAML Blessed things
- if (defined YAML->global_object()->{blessed_map}{$node_id}) {
- $value = YAML->global_object()->{blessed_map}{$node_id};
- $self->transferred->{$node_id} = $value;
- ($class, $type, $node_id) = $self->node_info($value, $stringify);
- $self->_prewalk($value);
- return;
- }
-
- # Handle hard refs
- if ($type eq 'REF' or $type eq 'SCALAR') {
- $value = YAML::Type::ref->yaml_dump($value);
- $self->transferred->{$node_id} = $value;
- (undef, $type, $node_id) = $self->node_info($value, $stringify);
- }
-
- # Handle ref-to-glob's
- elsif ($type eq 'GLOB') {
- my $ref_ynode = $self->transferred->{$node_id} =
- YAML::Type::ref->yaml_dump($value);
-
- my $glob_ynode = $ref_ynode->{&VALUE} =
- YAML::Type::glob->yaml_dump($$value);
-
- (undef, undef, $node_id) = $self->node_info($glob_ynode, $stringify);
- $self->transferred->{$node_id} = $glob_ynode;
- $self->_prewalk($glob_ynode);
- return;
- }
-
- # Increment ref count for node
- return if ++($self->{id_refcnt}{$node_id}) > 1;
-
- # Keep on walking
- if ($type eq 'HASH') {
- $self->_prewalk($value->{$_})
- for keys %{$value};
- return;
- }
- elsif ($type eq 'ARRAY') {
- $self->_prewalk($_)
- for @{$value};
- return;
- }
-
- # Unknown type. Need to know about it.
- $self->warn(<<"...");
-YAML::Dumper can't handle dumping this type of data.
-Please report this to the author.
-
-id: $node_id
-type: $type
-class: $class
-value: $value
-
-...
-
- return;
-}
-
-# Every data element and sub data element is a node.
-# Everything emitted goes through this function.
-sub _emit_node {
- my $self = shift;
- my ($type, $node_id);
- my $ref = ref($_[0]);
- if ($ref) {
- if ($ref eq 'Regexp') {
- $self->_emit(' !!perl/regexp');
- $self->_emit_str("$_[0]");
- return;
- }
- (undef, $type, $node_id) = $self->node_info($_[0], $self->stringify);
- }
- else {
- $type = $ref || 'SCALAR';
- (undef, undef, $node_id) = $self->node_info(\$_[0], $self->stringify);
- }
-
- my ($ynode, $tag) = ('') x 2;
- my ($value, $context) = (@_, 0);
-
- if (defined $self->transferred->{$node_id}) {
- $value = $self->transferred->{$node_id};
- $ynode = ynode($value);
- if (ref $value) {
- $tag = defined $ynode ? $ynode->tag->short : '';
- (undef, $type, $node_id) =
- $self->node_info($value, $self->stringify);
- }
- else {
- $ynode = ynode($self->transferred->{$node_id});
- $tag = defined $ynode ? $ynode->tag->short : '';
- $type = 'SCALAR';
- (undef, undef, $node_id) =
- $self->node_info(
- \ $self->transferred->{$node_id},
- $self->stringify
- );
- }
- }
- elsif ($ynode = ynode($value)) {
- $tag = $ynode->tag->short;
- }
-
- if ($self->use_aliases) {
- $self->{id_refcnt}{$node_id} ||= 0;
- if ($self->{id_refcnt}{$node_id} > 1) {
- if (defined $self->{id_anchor}{$node_id}) {
- $self->{stream} .= ' *' . $self->{id_anchor}{$node_id} . "\n";
- return;
- }
- my $anchor = $self->anchor_prefix . $self->{anchor}++;
- $self->{stream} .= ' &' . $anchor;
- $self->{id_anchor}{$node_id} = $anchor;
- }
- }
-
- return $self->_emit_str("$value") # Stringified object
- if ref($value) and not $type;
- return $self->_emit_scalar($value, $tag)
- if $type eq 'SCALAR' and $tag;
- return $self->_emit_str($value)
- if $type eq 'SCALAR';
- return $self->_emit_mapping($value, $tag, $node_id, $context)
- if $type eq 'HASH';
- return $self->_emit_sequence($value, $tag)
- if $type eq 'ARRAY';
- $self->warn('YAML_DUMP_WARN_BAD_NODE_TYPE', $type);
- return $self->_emit_str("$value");
-}
-
-# A YAML mapping is akin to a Perl hash.
-sub _emit_mapping {
- my $self = shift;
- my ($value, $tag, $node_id, $context) = @_;
- $self->{stream} .= " !$tag" if $tag;
-
- # Sometimes 'keys' fails. Like on a bad tie implementation.
- my $empty_hash = not(eval {keys %$value});
- $self->warn('YAML_EMIT_WARN_KEYS', $@) if $@;
- return ($self->{stream} .= " {}\n") if $empty_hash;
-
- # If CompressSeries is on (default) and legal is this context, then
- # use it and make the indent level be 2 for this node.
- if ($context == FROMARRAY and
- $self->compress_series and
- not (defined $self->{id_anchor}{$node_id} or $tag or $empty_hash)
- ) {
- $self->{stream} .= ' ';
- $self->offset->[$self->level+1] = $self->offset->[$self->level] + 2;
- }
- else {
- $context = 0;
- $self->{stream} .= "\n"
- unless $self->headless && not($self->headless(0));
- $self->offset->[$self->level+1] =
- $self->offset->[$self->level] + $self->indent_width;
- }
-
- $self->{level}++;
- my @keys;
- if ($self->sort_keys == 1) {
- if (ynode($value)) {
- @keys = keys %$value;
- }
- else {
- @keys = sort keys %$value;
- }
- }
- elsif ($self->sort_keys == 2) {
- @keys = sort keys %$value;
- }
- # XXX This is hackish but sometimes handy. Not sure whether to leave it in.
- elsif (ref($self->sort_keys) eq 'ARRAY') {
- my $i = 1;
- my %order = map { ($_, $i++) } @{$self->sort_keys};
- @keys = sort {
- (defined $order{$a} and defined $order{$b})
- ? ($order{$a} <=> $order{$b})
- : ($a cmp $b);
- } keys %$value;
- }
- else {
- @keys = keys %$value;
- }
- # Force the YAML::VALUE ('=') key to sort last.
- if (exists $value->{&VALUE}) {
- for (my $i = 0; $i < @keys; $i++) {
- if ($keys[$i] eq &VALUE) {
- splice(@keys, $i, 1);
- push @keys, &VALUE;
- last;
- }
- }
- }
-
- for my $key (@keys) {
- $self->_emit_key($key, $context);
- $context = 0;
- $self->{stream} .= ':';
- $self->_emit_node($value->{$key});
- }
- $self->{level}--;
-}
-
-# A YAML series is akin to a Perl array.
-sub _emit_sequence {
- my $self = shift;
- my ($value, $tag) = @_;
- $self->{stream} .= " !$tag" if $tag;
-
- return ($self->{stream} .= " []\n") if @$value == 0;
-
- $self->{stream} .= "\n"
- unless $self->headless && not($self->headless(0));
-
- # XXX Really crufty feature. Better implemented by ynodes.
- if ($self->inline_series and
- @$value <= $self->inline_series and
- not (scalar grep {ref or /\n/} @$value)
- ) {
- $self->{stream} =~ s/\n\Z/ /;
- $self->{stream} .= '[';
- for (my $i = 0; $i < @$value; $i++) {
- $self->_emit_str($value->[$i], KEY);
- last if $i == $#{$value};
- $self->{stream} .= ', ';
- }
- $self->{stream} .= "]\n";
- return;
- }
-
- $self->offset->[$self->level + 1] =
- $self->offset->[$self->level] + $self->indent_width;
- $self->{level}++;
- for my $val (@$value) {
- $self->{stream} .= ' ' x $self->offset->[$self->level];
- $self->{stream} .= '-';
- $self->_emit_node($val, FROMARRAY);
- }
- $self->{level}--;
-}
-
-# Emit a mapping key
-sub _emit_key {
- my $self = shift;
- my ($value, $context) = @_;
- $self->{stream} .= ' ' x $self->offset->[$self->level]
- unless $context == FROMARRAY;
- $self->_emit_str($value, KEY);
-}
-
-# Emit a blessed SCALAR
-sub _emit_scalar {
- my $self = shift;
- my ($value, $tag) = @_;
- $self->{stream} .= " !$tag";
- $self->_emit_str($value, BLESSED);
-}
-
-sub _emit {
- my $self = shift;
- $self->{stream} .= join '', @_;
-}
-
-# Emit a string value. YAML has many scalar styles. This routine attempts to
-# guess the best style for the text.
-sub _emit_str {
- my $self = shift;
- my $type = $_[1] || 0;
-
- # Use heuristics to find the best scalar emission style.
- $self->offset->[$self->level + 1] =
- $self->offset->[$self->level] + $self->indent_width;
- $self->{level}++;
-
- my $sf = $type == KEY ? '' : ' ';
- my $sb = $type == KEY ? '? ' : ' ';
- my $ef = $type == KEY ? '' : "\n";
- my $eb = "\n";
-
- while (1) {
- $self->_emit($sf),
- $self->_emit_plain($_[0]),
- $self->_emit($ef), last
- if not defined $_[0];
- $self->_emit($sf, '=', $ef), last
- if $_[0] eq VALUE;
- $self->_emit($sf),
- $self->_emit_double($_[0]),
- $self->_emit($ef), last
- if $_[0] =~ /$ESCAPE_CHAR/;
- if ($_[0] =~ /\n/) {
- $self->_emit($sb),
- $self->_emit_block($LIT_CHAR, $_[0]),
- $self->_emit($eb), last
- if $self->use_block;
- Carp::cluck "[YAML] \$UseFold is no longer supported"
- if $self->use_fold;
- $self->_emit($sf),
- $self->_emit_double($_[0]),
- $self->_emit($ef), last
- if length $_[0] <= 30;
- $self->_emit($sf),
- $self->_emit_double($_[0]),
- $self->_emit($ef), last
- if $_[0] !~ /\n\s*\S/;
- $self->_emit($sb),
- $self->_emit_block($LIT_CHAR, $_[0]),
- $self->_emit($eb), last;
- }
- $self->_emit($sf),
- $self->_emit_plain($_[0]),
- $self->_emit($ef), last
- if $self->is_valid_plain($_[0]);
- $self->_emit($sf),
- $self->_emit_double($_[0]),
- $self->_emit($ef), last
- if $_[0] =~ /'/;
- $self->_emit($sf),
- $self->_emit_single($_[0]),
- $self->_emit($ef);
- last;
- }
-
- $self->{level}--;
-
- return;
-}
-
-# Check whether or not a scalar should be emitted as an plain scalar.
-sub is_valid_plain {
- my $self = shift;
- return 0 unless length $_[0];
- # refer to YAML::Loader::parse_inline_simple()
- return 0 if $_[0] =~ /^[\s\{\[\~\`\'\"\!\@\#\>\|\%\&\?\*\^]/;
- return 0 if $_[0] =~ /[\{\[\]\},]/;
- return 0 if $_[0] =~ /[:\-\?]\s/;
- return 0 if $_[0] =~ /\s#/;
- return 0 if $_[0] =~ /\:(\s|$)/;
- return 0 if $_[0] =~ /[\s\|\>]$/;
- return 1;
-}
-
-sub _emit_block {
- my $self = shift;
- my ($indicator, $value) = @_;
- $self->{stream} .= $indicator;
- $value =~ /(\n*)\Z/;
- my $chomp = length $1 ? (length $1 > 1) ? '+' : '' : '-';
- $value = '~' if not defined $value;
- $self->{stream} .= $chomp;
- $self->{stream} .= $self->indent_width if $value =~ /^\s/;
- $self->{stream} .= $self->indent($value);
-}
-
-# Plain means that the scalar is unquoted.
-sub _emit_plain {
- my $self = shift;
- $self->{stream} .= defined $_[0] ? $_[0] : '~';
-}
-
-# Double quoting is for single lined escaped strings.
-sub _emit_double {
- my $self = shift;
- (my $escaped = $self->escape($_[0])) =~ s/"/\\"/g;
- $self->{stream} .= qq{"$escaped"};
-}
-
-# Single quoting is for single lined unescaped strings.
-sub _emit_single {
- my $self = shift;
- my $item = shift;
- $item =~ s{'}{''}g;
- $self->{stream} .= "'$item'";
-}
-
-#==============================================================================
-# Utility subroutines.
-#==============================================================================
-
-# Indent a scalar to the current indentation level.
-sub indent {
- my $self = shift;
- my ($text) = @_;
- return $text unless length $text;
- $text =~ s/\n\Z//;
- my $indent = ' ' x $self->offset->[$self->level];
- $text =~ s/^/$indent/gm;
- $text = "\n$text";
- return $text;
-}
-
-# Escapes for unprintable characters
-my @escapes = qw(\0 \x01 \x02 \x03 \x04 \x05 \x06 \a
- \x08 \t \n \v \f \r \x0e \x0f
- \x10 \x11 \x12 \x13 \x14 \x15 \x16 \x17
- \x18 \x19 \x1a \e \x1c \x1d \x1e \x1f
- );
-
-# Escape the unprintable characters
-sub escape {
- my $self = shift;
- my ($text) = @_;
- $text =~ s/\\/\\\\/g;
- $text =~ s/([\x00-\x1f])/$escapes[ord($1)]/ge;
- return $text;
-}
-
-1;
-
-__END__
-
-=head1 NAME
-
-YAML::Dumper - YAML class for dumping Perl objects to YAML
-
-=head1 SYNOPSIS
-
- use YAML::Dumper;
- my $dumper = YAML::Dumper->new;
- $dumper->indent_width(4);
- print $dumper->dump({foo => 'bar'});
-
-=head1 DESCRIPTION
-
-YAML::Dumper is the module that YAML.pm used to serialize Perl objects to
-YAML. It is fully object oriented and usable on its own.
-
-=head1 AUTHOR
-
-Ingy döt Net <ingy@cpan.org>
-
-=head1 COPYRIGHT
-
-Copyright (c) 2006. Ingy döt Net. All rights reserved.
-
-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/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/YAML/Dumper/Base.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/YAML/Dumper/Base.pm
deleted file mode 100644
index 8e4de0c874a..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/YAML/Dumper/Base.pm
+++ /dev/null
@@ -1,137 +0,0 @@
-package YAML::Dumper::Base;
-use strict; use warnings;
-use YAML::Base; use base 'YAML::Base';
-use YAML::Node;
-
-# YAML Dumping options
-field spec_version => '1.0';
-field indent_width => 2;
-field use_header => 1;
-field use_version => 0;
-field sort_keys => 1;
-field anchor_prefix => '';
-field dump_code => 0;
-field use_block => 0;
-field use_fold => 0;
-field compress_series => 1;
-field inline_series => 0;
-field use_aliases => 1;
-field purity => 0;
-field stringify => 0;
-
-# Properties
-field stream => '';
-field document => 0;
-field transferred => {};
-field id_refcnt => {};
-field id_anchor => {};
-field anchor => 1;
-field level => 0;
-field offset => [];
-field headless => 0;
-field blessed_map => {};
-
-# Global Options are an idea taken from Data::Dumper. Really they are just
-# sugar on top of real OO properties. They make the simple Dump/Load API
-# easy to configure.
-sub set_global_options {
- my $self = shift;
- $self->spec_version($YAML::SpecVersion)
- if defined $YAML::SpecVersion;
- $self->indent_width($YAML::Indent)
- if defined $YAML::Indent;
- $self->use_header($YAML::UseHeader)
- if defined $YAML::UseHeader;
- $self->use_version($YAML::UseVersion)
- if defined $YAML::UseVersion;
- $self->sort_keys($YAML::SortKeys)
- if defined $YAML::SortKeys;
- $self->anchor_prefix($YAML::AnchorPrefix)
- if defined $YAML::AnchorPrefix;
- $self->dump_code($YAML::DumpCode || $YAML::UseCode)
- if defined $YAML::DumpCode or defined $YAML::UseCode;
- $self->use_block($YAML::UseBlock)
- if defined $YAML::UseBlock;
- $self->use_fold($YAML::UseFold)
- if defined $YAML::UseFold;
- $self->compress_series($YAML::CompressSeries)
- if defined $YAML::CompressSeries;
- $self->inline_series($YAML::InlineSeries)
- if defined $YAML::InlineSeries;
- $self->use_aliases($YAML::UseAliases)
- if defined $YAML::UseAliases;
- $self->purity($YAML::Purity)
- if defined $YAML::Purity;
- $self->stringify($YAML::Stringify)
- if defined $YAML::Stringify;
-}
-
-sub dump {
- my $self = shift;
- $self->die('dump() not implemented in this class.');
-}
-
-sub blessed {
- my $self = shift;
- my ($ref) = @_;
- $ref = \$_[0] unless ref $ref;
- my (undef, undef, $node_id) = YAML::Base->node_info($ref);
- $self->{blessed_map}->{$node_id};
-}
-
-sub bless {
- my $self = shift;
- my ($ref, $blessing) = @_;
- my $ynode;
- $ref = \$_[0] unless ref $ref;
- my (undef, undef, $node_id) = YAML::Base->node_info($ref);
- if (not defined $blessing) {
- $ynode = YAML::Node->new($ref);
- }
- elsif (ref $blessing) {
- $self->die() unless ynode($blessing);
- $ynode = $blessing;
- }
- else {
- no strict 'refs';
- my $transfer = $blessing . "::yaml_dump";
- $self->die() unless defined &{$transfer};
- $ynode = &{$transfer}($ref);
- $self->die() unless ynode($ynode);
- }
- $self->{blessed_map}->{$node_id} = $ynode;
- my $object = ynode($ynode) or $self->die();
- return $object;
-}
-
-1;
-
-__END__
-
-=head1 NAME
-
-YAML::Dumper::Base - Base class for YAML Dumper classes
-
-=head1 SYNOPSIS
-
- package YAML::Dumper::Something;
- use YAML::Dumper::Base -base;
-
-=head1 DESCRIPTION
-
-YAML::Dumper::Base is a base class for creating YAML dumper classes.
-
-=head1 AUTHOR
-
-Ingy döt Net <ingy@cpan.org>
-
-=head1 COPYRIGHT
-
-Copyright (c) 2006. Ingy döt Net. All rights reserved.
-
-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/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/YAML/Error.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/YAML/Error.pm
deleted file mode 100644
index 23b9c5ca51f..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/YAML/Error.pm
+++ /dev/null
@@ -1,220 +0,0 @@
-package YAML::Error;
-use strict; use warnings;
-use YAML::Base; use base 'YAML::Base';
-
-field 'code';
-field 'type' => 'Error';
-field 'line';
-field 'document';
-field 'arguments' => [];
-
-my ($error_messages, %line_adjust);
-
-sub format_message {
- my $self = shift;
- my $output = 'YAML ' . $self->type . ': ';
- my $code = $self->code;
- if ($error_messages->{$code}) {
- $code = sprintf($error_messages->{$code}, @{$self->arguments});
- }
- $output .= $code . "\n";
-
- $output .= ' Code: ' . $self->code . "\n"
- if defined $self->code;
- $output .= ' Line: ' . $self->line . "\n"
- if defined $self->line;
- $output .= ' Document: ' . $self->document . "\n"
- if defined $self->document;
- return $output;
-}
-
-sub error_messages {
- $error_messages;
-}
-
-%$error_messages = map {s/^\s+//;$_} split "\n", <<'...';
-YAML_PARSE_ERR_BAD_CHARS
- Invalid characters in stream. This parser only supports printable ASCII
-YAML_PARSE_ERR_NO_FINAL_NEWLINE
- Stream does not end with newline character
-YAML_PARSE_ERR_BAD_MAJOR_VERSION
- Can't parse a %s document with a 1.0 parser
-YAML_PARSE_WARN_BAD_MINOR_VERSION
- Parsing a %s document with a 1.0 parser
-YAML_PARSE_WARN_MULTIPLE_DIRECTIVES
- '%s directive used more than once'
-YAML_PARSE_ERR_TEXT_AFTER_INDICATOR
- No text allowed after indicator
-YAML_PARSE_ERR_NO_ANCHOR
- No anchor for alias '*%s'
-YAML_PARSE_ERR_NO_SEPARATOR
- Expected separator '---'
-YAML_PARSE_ERR_SINGLE_LINE
- Couldn't parse single line value
-YAML_PARSE_ERR_BAD_ANCHOR
- Invalid anchor
-YAML_DUMP_ERR_INVALID_INDENT
- Invalid Indent width specified: '%s'
-YAML_LOAD_USAGE
- usage: YAML::Load($yaml_stream_scalar)
-YAML_PARSE_ERR_BAD_NODE
- Can't parse node
-YAML_PARSE_ERR_BAD_EXPLICIT
- Unsupported explicit transfer: '%s'
-YAML_DUMP_USAGE_DUMPCODE
- Invalid value for DumpCode: '%s'
-YAML_LOAD_ERR_FILE_INPUT
- Couldn't open %s for input:\n%s
-YAML_DUMP_ERR_FILE_CONCATENATE
- Can't concatenate to YAML file %s
-YAML_DUMP_ERR_FILE_OUTPUT
- Couldn't open %s for output:\n%s
-YAML_DUMP_ERR_NO_HEADER
- With UseHeader=0, the node must be a plain hash or array
-YAML_DUMP_WARN_BAD_NODE_TYPE
- Can't perform serialization for node type: '%s'
-YAML_EMIT_WARN_KEYS
- Encountered a problem with 'keys':\n%s
-YAML_DUMP_WARN_DEPARSE_FAILED
- Deparse failed for CODE reference
-YAML_DUMP_WARN_CODE_DUMMY
- Emitting dummy subroutine for CODE reference
-YAML_PARSE_ERR_MANY_EXPLICIT
- More than one explicit transfer
-YAML_PARSE_ERR_MANY_IMPLICIT
- More than one implicit request
-YAML_PARSE_ERR_MANY_ANCHOR
- More than one anchor
-YAML_PARSE_ERR_ANCHOR_ALIAS
- Can't define both an anchor and an alias
-YAML_PARSE_ERR_BAD_ALIAS
- Invalid alias
-YAML_PARSE_ERR_MANY_ALIAS
- More than one alias
-YAML_LOAD_ERR_NO_CONVERT
- Can't convert implicit '%s' node to explicit '%s' node
-YAML_LOAD_ERR_NO_DEFAULT_VALUE
- No default value for '%s' explicit transfer
-YAML_LOAD_ERR_NON_EMPTY_STRING
- Only the empty string can be converted to a '%s'
-YAML_LOAD_ERR_BAD_MAP_TO_SEQ
- Can't transfer map as sequence. Non numeric key '%s' encountered.
-YAML_DUMP_ERR_BAD_GLOB
- '%s' is an invalid value for Perl glob
-YAML_DUMP_ERR_BAD_REGEXP
- '%s' is an invalid value for Perl Regexp
-YAML_LOAD_ERR_BAD_MAP_ELEMENT
- Invalid element in map
-YAML_LOAD_WARN_DUPLICATE_KEY
- Duplicate map key found. Ignoring.
-YAML_LOAD_ERR_BAD_SEQ_ELEMENT
- Invalid element in sequence
-YAML_PARSE_ERR_INLINE_MAP
- Can't parse inline map
-YAML_PARSE_ERR_INLINE_SEQUENCE
- Can't parse inline sequence
-YAML_PARSE_ERR_BAD_DOUBLE
- Can't parse double quoted string
-YAML_PARSE_ERR_BAD_SINGLE
- Can't parse single quoted string
-YAML_PARSE_ERR_BAD_INLINE_IMPLICIT
- Can't parse inline implicit value '%s'
-YAML_PARSE_ERR_BAD_IMPLICIT
- Unrecognized implicit value '%s'
-YAML_PARSE_ERR_INDENTATION
- Error. Invalid indentation level
-YAML_PARSE_ERR_INCONSISTENT_INDENTATION
- Inconsistent indentation level
-YAML_LOAD_WARN_UNRESOLVED_ALIAS
- Can't resolve alias *%s
-YAML_LOAD_WARN_NO_REGEXP_IN_REGEXP
- No 'REGEXP' element for Perl regexp
-YAML_LOAD_WARN_BAD_REGEXP_ELEM
- Unknown element '%s' in Perl regexp
-YAML_LOAD_WARN_GLOB_NAME
- No 'NAME' element for Perl glob
-YAML_LOAD_WARN_PARSE_CODE
- Couldn't parse Perl code scalar: %s
-YAML_LOAD_WARN_CODE_DEPARSE
- Won't parse Perl code unless $YAML::LoadCode is set
-YAML_EMIT_ERR_BAD_LEVEL
- Internal Error: Bad level detected
-YAML_PARSE_WARN_AMBIGUOUS_TAB
- Amibiguous tab converted to spaces
-YAML_LOAD_WARN_BAD_GLOB_ELEM
- Unknown element '%s' in Perl glob
-YAML_PARSE_ERR_ZERO_INDENT
- Can't use zero as an indentation width
-YAML_LOAD_WARN_GLOB_IO
- Can't load an IO filehandle. Yet!!!
-...
-
-%line_adjust = map {($_, 1)}
- qw(YAML_PARSE_ERR_BAD_MAJOR_VERSION
- YAML_PARSE_WARN_BAD_MINOR_VERSION
- YAML_PARSE_ERR_TEXT_AFTER_INDICATOR
- YAML_PARSE_ERR_NO_ANCHOR
- YAML_PARSE_ERR_MANY_EXPLICIT
- YAML_PARSE_ERR_MANY_IMPLICIT
- YAML_PARSE_ERR_MANY_ANCHOR
- YAML_PARSE_ERR_ANCHOR_ALIAS
- YAML_PARSE_ERR_BAD_ALIAS
- YAML_PARSE_ERR_MANY_ALIAS
- YAML_LOAD_ERR_NO_CONVERT
- YAML_LOAD_ERR_NO_DEFAULT_VALUE
- YAML_LOAD_ERR_NON_EMPTY_STRING
- YAML_LOAD_ERR_BAD_MAP_TO_SEQ
- YAML_LOAD_ERR_BAD_STR_TO_INT
- YAML_LOAD_ERR_BAD_STR_TO_DATE
- YAML_LOAD_ERR_BAD_STR_TO_TIME
- YAML_LOAD_WARN_DUPLICATE_KEY
- YAML_PARSE_ERR_INLINE_MAP
- YAML_PARSE_ERR_INLINE_SEQUENCE
- YAML_PARSE_ERR_BAD_DOUBLE
- YAML_PARSE_ERR_BAD_SINGLE
- YAML_PARSE_ERR_BAD_INLINE_IMPLICIT
- YAML_PARSE_ERR_BAD_IMPLICIT
- YAML_LOAD_WARN_NO_REGEXP_IN_REGEXP
- YAML_LOAD_WARN_BAD_REGEXP_ELEM
- YAML_LOAD_WARN_REGEXP_CREATE
- YAML_LOAD_WARN_GLOB_NAME
- YAML_LOAD_WARN_PARSE_CODE
- YAML_LOAD_WARN_CODE_DEPARSE
- YAML_LOAD_WARN_BAD_GLOB_ELEM
- YAML_PARSE_ERR_ZERO_INDENT
- );
-
-package YAML::Warning;
-use base 'YAML::Error';
-
-1;
-
-__END__
-
-=head1 NAME
-
-YAML::Error - Error formatting class for YAML modules
-
-=head1 SYNOPSIS
-
- $self->die('YAML_PARSE_ERR_NO_ANCHOR', $alias);
- $self->warn('YAML_LOAD_WARN_DUPLICATE_KEY');
-
-=head1 DESCRIPTION
-
-This module provides a C<die> and a C<warn> facility.
-
-=head1 AUTHOR
-
-Ingy döt Net <ingy@cpan.org>
-
-=head1 COPYRIGHT
-
-Copyright (c) 2006. Ingy döt Net. All rights reserved.
-
-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/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/YAML/Loader.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/YAML/Loader.pm
deleted file mode 100644
index fe76224d4b6..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/YAML/Loader.pm
+++ /dev/null
@@ -1,780 +0,0 @@
-package YAML::Loader;
-use strict; use warnings;
-use YAML::Base;
-use base 'YAML::Loader::Base';
-use YAML::Types;
-
-# Context constants
-use constant LEAF => 1;
-use constant COLLECTION => 2;
-use constant VALUE => "\x07YAML\x07VALUE\x07";
-use constant COMMENT => "\x07YAML\x07COMMENT\x07";
-
-# Common YAML character sets
-my $ESCAPE_CHAR = '[\\x00-\\x08\\x0b-\\x0d\\x0e-\\x1f]';
-my $FOLD_CHAR = '>';
-my $LIT_CHAR = '|';
-my $LIT_CHAR_RX = "\\$LIT_CHAR";
-
-sub load {
- my $self = shift;
- $self->stream($_[0] || '');
- return $self->_parse();
-}
-
-# Top level function for parsing. Parse each document in order and
-# handle processing for YAML headers.
-sub _parse {
- my $self = shift;
- my (%directives, $preface);
- $self->{stream} =~ s|\015\012|\012|g;
- $self->{stream} =~ s|\015|\012|g;
- $self->line(0);
- $self->die('YAML_PARSE_ERR_BAD_CHARS')
- if $self->stream =~ /$ESCAPE_CHAR/;
- $self->die('YAML_PARSE_ERR_NO_FINAL_NEWLINE')
- if length($self->stream) and
- $self->{stream} !~ s/(.)\n\Z/$1/s;
- $self->lines([split /\x0a/, $self->stream, -1]);
- $self->line(1);
- # Throw away any comments or blanks before the header (or start of
- # content for headerless streams)
- $self->_parse_throwaway_comments();
- $self->document(0);
- $self->documents([]);
- # Add an "assumed" header if there is no header and the stream is
- # not empty (after initial throwaways).
- if (not $self->eos) {
- if ($self->lines->[0] !~ /^---(\s|$)/) {
- unshift @{$self->lines}, '---';
- $self->{line}--;
- }
- }
-
- # Main Loop. Parse out all the top level nodes and return them.
- while (not $self->eos) {
- $self->anchor2node({});
- $self->{document}++;
- $self->done(0);
- $self->level(0);
- $self->offset->[0] = -1;
-
- if ($self->lines->[0] =~ /^---\s*(.*)$/) {
- my @words = split /\s+/, $1;
- %directives = ();
- while (@words && $words[0] =~ /^#(\w+):(\S.*)$/) {
- my ($key, $value) = ($1, $2);
- shift(@words);
- if (defined $directives{$key}) {
- $self->warn('YAML_PARSE_WARN_MULTIPLE_DIRECTIVES',
- $key, $self->document);
- next;
- }
- $directives{$key} = $value;
- }
- $self->preface(join ' ', @words);
- }
- else {
- $self->die('YAML_PARSE_ERR_NO_SEPARATOR');
- }
-
- if (not $self->done) {
- $self->_parse_next_line(COLLECTION);
- }
- if ($self->done) {
- $self->{indent} = -1;
- $self->content('');
- }
-
- $directives{YAML} ||= '1.0';
- $directives{TAB} ||= 'NONE';
- ($self->{major_version}, $self->{minor_version}) =
- split /\./, $directives{YAML}, 2;
- $self->die('YAML_PARSE_ERR_BAD_MAJOR_VERSION', $directives{YAML})
- if $self->major_version ne '1';
- $self->warn('YAML_PARSE_WARN_BAD_MINOR_VERSION', $directives{YAML})
- if $self->minor_version ne '0';
- $self->die('Unrecognized TAB policy')
- unless $directives{TAB} =~ /^(NONE|\d+)(:HARD)?$/;
-
- push @{$self->documents}, $self->_parse_node();
- }
- return wantarray ? @{$self->documents} : $self->documents->[-1];
-}
-
-# This function is the dispatcher for parsing each node. Every node
-# recurses back through here. (Inlines are an exception as they have
-# their own sub-parser.)
-sub _parse_node {
- my $self = shift;
- my $preface = $self->preface;
- $self->preface('');
- my ($node, $type, $indicator, $escape, $chomp) = ('') x 5;
- my ($anchor, $alias, $explicit, $implicit, $class) = ('') x 5;
- ($anchor, $alias, $explicit, $implicit, $preface) =
- $self->_parse_qualifiers($preface);
- if ($anchor) {
- $self->anchor2node->{$anchor} = CORE::bless [], 'YAML-anchor2node';
- }
- $self->inline('');
- while (length $preface) {
- my $line = $self->line - 1;
- if ($preface =~ s/^($FOLD_CHAR|$LIT_CHAR_RX)(-|\+)?\d*\s*//) {
- $indicator = $1;
- $chomp = $2 if defined($2);
- }
- else {
- $self->die('YAML_PARSE_ERR_TEXT_AFTER_INDICATOR') if $indicator;
- $self->inline($preface);
- $preface = '';
- }
- }
- if ($alias) {
- $self->die('YAML_PARSE_ERR_NO_ANCHOR', $alias)
- unless defined $self->anchor2node->{$alias};
- if (ref($self->anchor2node->{$alias}) ne 'YAML-anchor2node') {
- $node = $self->anchor2node->{$alias};
- }
- else {
- $node = do {my $sv = "*$alias"};
- push @{$self->anchor2node->{$alias}}, [\$node, $self->line];
- }
- }
- elsif (length $self->inline) {
- $node = $self->_parse_inline(1, $implicit, $explicit);
- if (length $self->inline) {
- $self->die('YAML_PARSE_ERR_SINGLE_LINE');
- }
- }
- elsif ($indicator eq $LIT_CHAR) {
- $self->{level}++;
- $node = $self->_parse_block($chomp);
- $node = $self->_parse_implicit($node) if $implicit;
- $self->{level}--;
- }
- elsif ($indicator eq $FOLD_CHAR) {
- $self->{level}++;
- $node = $self->_parse_unfold($chomp);
- $node = $self->_parse_implicit($node) if $implicit;
- $self->{level}--;
- }
- else {
- $self->{level}++;
- $self->offset->[$self->level] ||= 0;
- if ($self->indent == $self->offset->[$self->level]) {
- if ($self->content =~ /^-( |$)/) {
- $node = $self->_parse_seq($anchor);
- }
- elsif ($self->content =~ /(^\?|\:( |$))/) {
- $node = $self->_parse_mapping($anchor);
- }
- elsif ($preface =~ /^\s*$/) {
- $node = $self->_parse_implicit('');
- }
- else {
- $self->die('YAML_PARSE_ERR_BAD_NODE');
- }
- }
- else {
- $node = undef;
- }
- $self->{level}--;
- }
- $#{$self->offset} = $self->level;
-
- if ($explicit) {
- if ($class) {
- if (not ref $node) {
- my $copy = $node;
- undef $node;
- $node = \$copy;
- }
- CORE::bless $node, $class;
- }
- else {
- $node = $self->_parse_explicit($node, $explicit);
- }
- }
- if ($anchor) {
- if (ref($self->anchor2node->{$anchor}) eq 'YAML-anchor2node') {
- # XXX Can't remember what this code actually does
- for my $ref (@{$self->anchor2node->{$anchor}}) {
- ${$ref->[0]} = $node;
- $self->warn('YAML_LOAD_WARN_UNRESOLVED_ALIAS',
- $anchor, $ref->[1]);
- }
- }
- $self->anchor2node->{$anchor} = $node;
- }
- return $node;
-}
-
-# Preprocess the qualifiers that may be attached to any node.
-sub _parse_qualifiers {
- my $self = shift;
- my ($preface) = @_;
- my ($anchor, $alias, $explicit, $implicit, $token) = ('') x 5;
- $self->inline('');
- while ($preface =~ /^[&*!]/) {
- my $line = $self->line - 1;
- if ($preface =~ s/^\!(\S+)\s*//) {
- $self->die('YAML_PARSE_ERR_MANY_EXPLICIT') if $explicit;
- $explicit = $1;
- }
- elsif ($preface =~ s/^\!\s*//) {
- $self->die('YAML_PARSE_ERR_MANY_IMPLICIT') if $implicit;
- $implicit = 1;
- }
- elsif ($preface =~ s/^\&([^ ,:]+)\s*//) {
- $token = $1;
- $self->die('YAML_PARSE_ERR_BAD_ANCHOR')
- unless $token =~ /^[a-zA-Z0-9]+$/;
- $self->die('YAML_PARSE_ERR_MANY_ANCHOR') if $anchor;
- $self->die('YAML_PARSE_ERR_ANCHOR_ALIAS') if $alias;
- $anchor = $token;
- }
- elsif ($preface =~ s/^\*([^ ,:]+)\s*//) {
- $token = $1;
- $self->die('YAML_PARSE_ERR_BAD_ALIAS')
- unless $token =~ /^[a-zA-Z0-9]+$/;
- $self->die('YAML_PARSE_ERR_MANY_ALIAS') if $alias;
- $self->die('YAML_PARSE_ERR_ANCHOR_ALIAS') if $anchor;
- $alias = $token;
- }
- }
- return ($anchor, $alias, $explicit, $implicit, $preface);
-}
-
-# Morph a node to it's explicit type
-sub _parse_explicit {
- my $self = shift;
- my ($node, $explicit) = @_;
- my ($type, $class);
- if ($explicit =~ /^\!?perl\/(hash|array|ref|scalar)(?:\:(\w(\w|\:\:)*)?)?$/) {
- ($type, $class) = (($1 || ''), ($2 || ''));
-
- # FIXME # die unless uc($type) eq ref($node) ?
-
- if ( $type eq "ref" ) {
- $self->die('YAML_LOAD_ERR_NO_DEFAULT_VALUE', 'XXX', $explicit)
- unless exists $node->{VALUE()} and scalar(keys %$node) == 1;
-
- my $value = $node->{VALUE()};
- $node = \$value;
- }
-
- if ( $type eq "scalar" and length($class) and !ref($node) ) {
- my $value = $node;
- $node = \$value;
- }
-
- if ( length($class) ) {
- CORE::bless($node, $class);
- }
-
- return $node;
- }
- if ($explicit =~ m{^!?perl/(glob|regexp|code)(?:\:(\w(\w|\:\:)*)?)?$}) {
- ($type, $class) = (($1 || ''), ($2 || ''));
- my $type_class = "YAML::Type::$type";
- no strict 'refs';
- if ($type_class->can('yaml_load')) {
- return $type_class->yaml_load($node, $class, $self);
- }
- else {
- $self->die('YAML_LOAD_ERR_NO_CONVERT', 'XXX', $explicit);
- }
- }
- # This !perl/@Foo and !perl/$Foo are deprecated but still parsed
- elsif ($YAML::TagClass->{$explicit} ||
- $explicit =~ m{^perl/(\@|\$)?([a-zA-Z](\w|::)+)$}
- ) {
- $class = $YAML::TagClass->{$explicit} || $2;
- if ($class->can('yaml_load')) {
- require YAML::Node;
- return $class->yaml_load(YAML::Node->new($node, $explicit));
- }
- else {
- if (ref $node) {
- return CORE::bless $node, $class;
- }
- else {
- return CORE::bless \$node, $class;
- }
- }
- }
- elsif (ref $node) {
- require YAML::Node;
- return YAML::Node->new($node, $explicit);
- }
- else {
- # XXX This is likely wrong. Failing test:
- # --- !unknown 'scalar value'
- return $node;
- }
-}
-
-# Parse a YAML mapping into a Perl hash
-sub _parse_mapping {
- my $self = shift;
- my ($anchor) = @_;
- my $mapping = {};
- $self->anchor2node->{$anchor} = $mapping;
- my $key;
- while (not $self->done and $self->indent == $self->offset->[$self->level]) {
- # If structured key:
- if ($self->{content} =~ s/^\?\s*//) {
- $self->preface($self->content);
- $self->_parse_next_line(COLLECTION);
- $key = $self->_parse_node();
- $key = "$key";
- }
- # If "default" key (equals sign)
- elsif ($self->{content} =~ s/^\=\s*//) {
- $key = VALUE;
- }
- # If "comment" key (slash slash)
- elsif ($self->{content} =~ s/^\=\s*//) {
- $key = COMMENT;
- }
- # Regular scalar key:
- else {
- $self->inline($self->content);
- $key = $self->_parse_inline();
- $key = "$key";
- $self->content($self->inline);
- $self->inline('');
- }
-
- unless ($self->{content} =~ s/^:\s*//) {
- $self->die('YAML_LOAD_ERR_BAD_MAP_ELEMENT');
- }
- $self->preface($self->content);
- my $line = $self->line;
- $self->_parse_next_line(COLLECTION);
- my $value = $self->_parse_node();
- if (exists $mapping->{$key}) {
- $self->warn('YAML_LOAD_WARN_DUPLICATE_KEY');
- }
- else {
- $mapping->{$key} = $value;
- }
- }
- return $mapping;
-}
-
-# Parse a YAML sequence into a Perl array
-sub _parse_seq {
- my $self = shift;
- my ($anchor) = @_;
- my $seq = [];
- $self->anchor2node->{$anchor} = $seq;
- while (not $self->done and $self->indent == $self->offset->[$self->level]) {
- if ($self->content =~ /^-(?: (.*))?$/) {
- $self->preface(defined($1) ? $1 : '');
- }
- else {
- $self->die('YAML_LOAD_ERR_BAD_SEQ_ELEMENT');
- }
- if ($self->preface =~ /^(\s*)(\w.*\:(?: |$).*)$/) {
- $self->indent($self->offset->[$self->level] + 2 + length($1));
- $self->content($2);
- $self->level($self->level + 1);
- $self->offset->[$self->level] = $self->indent;
- $self->preface('');
- push @$seq, $self->_parse_mapping('');
- $self->{level}--;
- $#{$self->offset} = $self->level;
- }
- else {
- $self->_parse_next_line(COLLECTION);
- push @$seq, $self->_parse_node();
- }
- }
- return $seq;
-}
-
-# Parse an inline value. Since YAML supports inline collections, this is
-# the top level of a sub parsing.
-sub _parse_inline {
- my $self = shift;
- my ($top, $top_implicit, $top_explicit) = (@_, '', '', '');
- $self->{inline} =~ s/^\s*(.*)\s*$/$1/; # OUCH - mugwump
- my ($node, $anchor, $alias, $explicit, $implicit) = ('') x 5;
- ($anchor, $alias, $explicit, $implicit, $self->{inline}) =
- $self->_parse_qualifiers($self->inline);
- if ($anchor) {
- $self->anchor2node->{$anchor} = CORE::bless [], 'YAML-anchor2node';
- }
- $implicit ||= $top_implicit;
- $explicit ||= $top_explicit;
- ($top_implicit, $top_explicit) = ('', '');
- if ($alias) {
- $self->die('YAML_PARSE_ERR_NO_ANCHOR', $alias)
- unless defined $self->anchor2node->{$alias};
- if (ref($self->anchor2node->{$alias}) ne 'YAML-anchor2node') {
- $node = $self->anchor2node->{$alias};
- }
- else {
- $node = do {my $sv = "*$alias"};
- push @{$self->anchor2node->{$alias}}, [\$node, $self->line];
- }
- }
- elsif ($self->inline =~ /^\{/) {
- $node = $self->_parse_inline_mapping($anchor);
- }
- elsif ($self->inline =~ /^\[/) {
- $node = $self->_parse_inline_seq($anchor);
- }
- elsif ($self->inline =~ /^"/) {
- $node = $self->_parse_inline_double_quoted();
- $node = $self->_unescape($node);
- $node = $self->_parse_implicit($node) if $implicit;
- }
- elsif ($self->inline =~ /^'/) {
- $node = $self->_parse_inline_single_quoted();
- $node = $self->_parse_implicit($node) if $implicit;
- }
- else {
- if ($top) {
- $node = $self->inline;
- $self->inline('');
- }
- else {
- $node = $self->_parse_inline_simple();
- }
- $node = $self->_parse_implicit($node) unless $explicit;
- }
- if ($explicit) {
- $node = $self->_parse_explicit($node, $explicit);
- }
- if ($anchor) {
- if (ref($self->anchor2node->{$anchor}) eq 'YAML-anchor2node') {
- for my $ref (@{$self->anchor2node->{$anchor}}) {
- ${$ref->[0]} = $node;
- $self->warn('YAML_LOAD_WARN_UNRESOLVED_ALIAS',
- $anchor, $ref->[1]);
- }
- }
- $self->anchor2node->{$anchor} = $node;
- }
- return $node;
-}
-
-# Parse the inline YAML mapping into a Perl hash
-sub _parse_inline_mapping {
- my $self = shift;
- my ($anchor) = @_;
- my $node = {};
- $self->anchor2node->{$anchor} = $node;
-
- $self->die('YAML_PARSE_ERR_INLINE_MAP')
- unless $self->{inline} =~ s/^\{\s*//;
- while (not $self->{inline} =~ s/^\s*\}//) {
- my $key = $self->_parse_inline();
- $self->die('YAML_PARSE_ERR_INLINE_MAP')
- unless $self->{inline} =~ s/^\: \s*//;
- my $value = $self->_parse_inline();
- if (exists $node->{$key}) {
- $self->warn('YAML_LOAD_WARN_DUPLICATE_KEY');
- }
- else {
- $node->{$key} = $value;
- }
- next if $self->inline =~ /^\s*\}/;
- $self->die('YAML_PARSE_ERR_INLINE_MAP')
- unless $self->{inline} =~ s/^\,\s*//;
- }
- return $node;
-}
-
-# Parse the inline YAML sequence into a Perl array
-sub _parse_inline_seq {
- my $self = shift;
- my ($anchor) = @_;
- my $node = [];
- $self->anchor2node->{$anchor} = $node;
-
- $self->die('YAML_PARSE_ERR_INLINE_SEQUENCE')
- unless $self->{inline} =~ s/^\[\s*//;
- while (not $self->{inline} =~ s/^\s*\]//) {
- my $value = $self->_parse_inline();
- push @$node, $value;
- next if $self->inline =~ /^\s*\]/;
- $self->die('YAML_PARSE_ERR_INLINE_SEQUENCE')
- unless $self->{inline} =~ s/^\,\s*//;
- }
- return $node;
-}
-
-# Parse the inline double quoted string.
-sub _parse_inline_double_quoted {
- my $self = shift;
- my $node;
- if ($self->inline =~ /^"((?:\\"|[^"])*)"\s*(.*)$/) {
- $node = $1;
- $self->inline($2);
- $node =~ s/\\"/"/g;
- }
- else {
- $self->die('YAML_PARSE_ERR_BAD_DOUBLE');
- }
- return $node;
-}
-
-
-# Parse the inline single quoted string.
-sub _parse_inline_single_quoted {
- my $self = shift;
- my $node;
- if ($self->inline =~ /^'((?:''|[^'])*)'\s*(.*)$/) {
- $node = $1;
- $self->inline($2);
- $node =~ s/''/'/g;
- }
- else {
- $self->die('YAML_PARSE_ERR_BAD_SINGLE');
- }
- return $node;
-}
-
-# Parse the inline unquoted string and do implicit typing.
-sub _parse_inline_simple {
- my $self = shift;
- my $value;
- if ($self->inline =~ /^(|[^!@#%^&*].*?)(?=[\[\]\{\},]|, |: |- |:\s*$|$)/) {
- $value = $1;
- substr($self->{inline}, 0, length($1)) = '';
- }
- else {
- $self->die('YAML_PARSE_ERR_BAD_INLINE_IMPLICIT', $value);
- }
- return $value;
-}
-
-sub _parse_implicit {
- my $self = shift;
- my ($value) = @_;
- $value =~ s/\s*$//;
- return $value if $value eq '';
- return undef if $value =~ /^~$/;
- return $value
- unless $value =~ /^[\@\`\^]/ or
- $value =~ /^[\-\?]\s/;
- $self->die('YAML_PARSE_ERR_BAD_IMPLICIT', $value);
-}
-
-# Unfold a YAML multiline scalar into a single string.
-sub _parse_unfold {
- my $self = shift;
- my ($chomp) = @_;
- my $node = '';
- my $space = 0;
- while (not $self->done and $self->indent == $self->offset->[$self->level]) {
- $node .= $self->content. "\n";
- $self->_parse_next_line(LEAF);
- }
- $node =~ s/^(\S.*)\n(?=\S)/$1 /gm;
- $node =~ s/^(\S.*)\n(\n+\S)/$1$2/gm;
- $node =~ s/\n*\Z// unless $chomp eq '+';
- $node .= "\n" unless $chomp;
- return $node;
-}
-
-# Parse a YAML block style scalar. This is like a Perl here-document.
-sub _parse_block {
- my $self = shift;
- my ($chomp) = @_;
- my $node = '';
- while (not $self->done and $self->indent == $self->offset->[$self->level]) {
- $node .= $self->content . "\n";
- $self->_parse_next_line(LEAF);
- }
- return $node if '+' eq $chomp;
- $node =~ s/\n*\Z/\n/;
- $node =~ s/\n\Z// if $chomp eq '-';
- return $node;
-}
-
-# Handle Perl style '#' comments. Comments must be at the same indentation
-# level as the collection line following them.
-sub _parse_throwaway_comments {
- my $self = shift;
- while (@{$self->lines} and
- $self->lines->[0] =~ m{^\s*(\#|$)}
- ) {
- shift @{$self->lines};
- $self->{line}++;
- }
- $self->eos($self->{done} = not @{$self->lines});
-}
-
-# This is the routine that controls what line is being parsed. It gets called
-# once for each line in the YAML stream.
-#
-# This routine must:
-# 1) Skip past the current line
-# 2) Determine the indentation offset for a new level
-# 3) Find the next _content_ line
-# A) Skip over any throwaways (Comments/blanks)
-# B) Set $self->indent, $self->content, $self->line
-# 4) Expand tabs appropriately
-sub _parse_next_line {
- my $self = shift;
- my ($type) = @_;
- my $level = $self->level;
- my $offset = $self->offset->[$level];
- $self->die('YAML_EMIT_ERR_BAD_LEVEL') unless defined $offset;
- shift @{$self->lines};
- $self->eos($self->{done} = not @{$self->lines});
- return if $self->eos;
- $self->{line}++;
-
- # Determine the offset for a new leaf node
- if ($self->preface =~
- qr/(?:^|\s)(?:$FOLD_CHAR|$LIT_CHAR_RX)(?:-|\+)?(\d*)\s*$/
- ) {
- $self->die('YAML_PARSE_ERR_ZERO_INDENT')
- if length($1) and $1 == 0;
- $type = LEAF;
- if (length($1)) {
- $self->offset->[$level + 1] = $offset + $1;
- }
- else {
- # First get rid of any comments.
- while (@{$self->lines} && ($self->lines->[0] =~ /^\s*#/)) {
- $self->lines->[0] =~ /^( *)/ or die;
- last unless length($1) <= $offset;
- shift @{$self->lines};
- $self->{line}++;
- }
- $self->eos($self->{done} = not @{$self->lines});
- return if $self->eos;
- if ($self->lines->[0] =~ /^( *)\S/ and length($1) > $offset) {
- $self->offset->[$level+1] = length($1);
- }
- else {
- $self->offset->[$level+1] = $offset + 1;
- }
- }
- $offset = $self->offset->[++$level];
- }
- # Determine the offset for a new collection level
- elsif ($type == COLLECTION and
- $self->preface =~ /^(\s*(\!\S*|\&\S+))*\s*$/) {
- $self->_parse_throwaway_comments();
- if ($self->eos) {
- $self->offset->[$level+1] = $offset + 1;
- return;
- }
- else {
- $self->lines->[0] =~ /^( *)\S/ or die;
- if (length($1) > $offset) {
- $self->offset->[$level+1] = length($1);
- }
- else {
- $self->offset->[$level+1] = $offset + 1;
- }
- }
- $offset = $self->offset->[++$level];
- }
-
- if ($type == LEAF) {
- while (@{$self->lines} and
- $self->lines->[0] =~ m{^( *)(\#)} and
- length($1) < $offset
- ) {
- shift @{$self->lines};
- $self->{line}++;
- }
- $self->eos($self->{done} = not @{$self->lines});
- }
- else {
- $self->_parse_throwaway_comments();
- }
- return if $self->eos;
-
- if ($self->lines->[0] =~ /^---(\s|$)/) {
- $self->done(1);
- return;
- }
- if ($type == LEAF and
- $self->lines->[0] =~ /^ {$offset}(.*)$/
- ) {
- $self->indent($offset);
- $self->content($1);
- }
- elsif ($self->lines->[0] =~ /^\s*$/) {
- $self->indent($offset);
- $self->content('');
- }
- else {
- $self->lines->[0] =~ /^( *)(\S.*)$/;
- while ($self->offset->[$level] > length($1)) {
- $level--;
- }
- $self->die('YAML_PARSE_ERR_INCONSISTENT_INDENTATION')
- if $self->offset->[$level] != length($1);
- $self->indent(length($1));
- $self->content($2);
- }
- $self->die('YAML_PARSE_ERR_INDENTATION')
- if $self->indent - $offset > 1;
-}
-
-#==============================================================================
-# Utility subroutines.
-#==============================================================================
-
-# Printable characters for escapes
-my %unescapes =
- (
- 0 => "\x00", a => "\x07", t => "\x09",
- n => "\x0a", v => "\x0b", f => "\x0c",
- r => "\x0d", e => "\x1b", '\\' => '\\',
- );
-
-# Transform all the backslash style escape characters to their literal meaning
-sub _unescape {
- my $self = shift;
- my ($node) = @_;
- $node =~ s/\\([never\\fart0]|x([0-9a-fA-F]{2}))/
- (length($1)>1)?pack("H2",$2):$unescapes{$1}/gex;
- return $node;
-}
-
-1;
-
-__END__
-
-=head1 NAME
-
-YAML::Loader - YAML class for loading Perl objects to YAML
-
-=head1 SYNOPSIS
-
- use YAML::Loader;
- my $loader = YAML::Loader->new;
- my $hash = $loader->load(<<'...');
- foo: bar
- ...
-
-=head1 DESCRIPTION
-
-YAML::Loader is the module that YAML.pm used to deserialize YAML to Perl
-objects. It is fully object oriented and usable on its own.
-
-=head1 AUTHOR
-
-Ingy döt Net <ingy@cpan.org>
-
-=head1 COPYRIGHT
-
-Copyright (c) 2006. Ingy döt Net. All rights reserved.
-
-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/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/YAML/Loader/Base.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/YAML/Loader/Base.pm
deleted file mode 100644
index 4d5b02dd003..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/YAML/Loader/Base.pm
+++ /dev/null
@@ -1,64 +0,0 @@
-package YAML::Loader::Base;
-use strict; use warnings;
-use YAML::Base; use base 'YAML::Base';
-
-field load_code => 0;
-
-field stream => '';
-field document => 0;
-field line => 0;
-field documents => [];
-field lines => [];
-field eos => 0;
-field done => 0;
-field anchor2node => {};
-field level => 0;
-field offset => [];
-field preface => '';
-field content => '';
-field indent => 0;
-field major_version => 0;
-field minor_version => 0;
-field inline => '';
-
-sub set_global_options {
- my $self = shift;
- $self->load_code($YAML::LoadCode || $YAML::UseCode)
- if defined $YAML::LoadCode or defined $YAML::UseCode;
-}
-
-sub load {
- die 'load() not implemented in this class.';
-}
-
-1;
-
-__END__
-
-=head1 NAME
-
-YAML::Loader::Base - Base class for YAML Loader classes
-
-=head1 SYNOPSIS
-
- package YAML::Loader::Something;
- use YAML::Loader::Base -base;
-
-=head1 DESCRIPTION
-
-YAML::Loader::Base is a base class for creating YAML loader classes.
-
-=head1 AUTHOR
-
-Ingy döt Net <ingy@cpan.org>
-
-=head1 COPYRIGHT
-
-Copyright (c) 2006. Ingy döt Net. All rights reserved.
-
-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/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/YAML/Marshall.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/YAML/Marshall.pm
deleted file mode 100644
index 5985ecea842..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/YAML/Marshall.pm
+++ /dev/null
@@ -1,77 +0,0 @@
-package YAML::Marshall;
-use strict; use warnings;
-use YAML::Node();
-
-sub import {
- my $class = shift;
- no strict 'refs';
- my $package = caller;
- unless (grep { $_ eq $class} @{$package . '::ISA'}) {
- push @{$package . '::ISA'}, $class;
- }
-
- my $tag = shift;
- if ($tag) {
- no warnings 'once';
- $YAML::TagClass->{$tag} = $package;
- ${$package . "::YamlTag"} = $tag;
- }
-}
-
-sub yaml_dump {
- my $self = shift;
- no strict 'refs';
- my $tag = ${ref($self) . "::YamlTag"} || 'perl/' . ref($self);
- $self->yaml_node($self, $tag);
-}
-
-sub yaml_load {
- my ($class, $node) = @_;
- if (my $ynode = $class->yaml_ynode($node)) {
- $node = $ynode->{NODE};
- }
- bless $node, $class;
-}
-
-sub yaml_node {
- shift;
- YAML::Node->new(@_);
-}
-
-sub yaml_ynode {
- shift;
- YAML::Node::ynode(@_);
-}
-
-1;
-
-__END__
-
-=head1 NAME
-
-YAML::Marshall - YAML marshalling class you can mixin to your classes
-
-=head1 SYNOPSIS
-
- package Bar;
- use Foo -base;
- use YAML::Marshall -mixin;
-
-=head1 DESCRIPTION
-
-For classes that want to handle their own YAML serialization.
-
-=head1 AUTHOR
-
-Ingy döt Net <ingy@cpan.org>
-
-=head1 COPYRIGHT
-
-Copyright (c) 2006. Ingy döt Net. All rights reserved.
-
-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/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/YAML/Node.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/YAML/Node.pm
deleted file mode 100644
index c7469c39adc..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/YAML/Node.pm
+++ /dev/null
@@ -1,297 +0,0 @@
-package YAML::Node;
-use strict; use warnings;
-use YAML::Base; use base 'YAML::Base';
-use YAML::Tag;
-
-our @EXPORT = qw(ynode);
-
-sub ynode {
- my $self;
- if (ref($_[0]) eq 'HASH') {
- $self = tied(%{$_[0]});
- }
- elsif (ref($_[0]) eq 'ARRAY') {
- $self = tied(@{$_[0]});
- }
- else {
- $self = tied($_[0]);
- }
- return (ref($self) =~ /^yaml_/) ? $self : undef;
-}
-
-sub new {
- my ($class, $node, $tag) = @_;
- my $self;
- $self->{NODE} = $node;
- my (undef, $type) = $class->node_info($node);
- $self->{KIND} = (not defined $type) ? 'scalar' :
- ($type eq 'ARRAY') ? 'sequence' :
- ($type eq 'HASH') ? 'mapping' :
- $class->die("Can't create YAML::Node from '$type'");
- tag($self, ($tag || ''));
- if ($self->{KIND} eq 'scalar') {
- yaml_scalar->new($self, $_[1]);
- return \ $_[1];
- }
- my $package = "yaml_" . $self->{KIND};
- $package->new($self)
-}
-
-sub node { $_->{NODE} }
-sub kind { $_->{KIND} }
-sub tag {
- my ($self, $value) = @_;
- if (defined $value) {
- $self->{TAG} = YAML::Tag->new($value);
- return $self;
- }
- else {
- return $self->{TAG};
- }
-}
-sub keys {
- my ($self, $value) = @_;
- if (defined $value) {
- $self->{KEYS} = $value;
- return $self;
- }
- else {
- return $self->{KEYS};
- }
-}
-
-#==============================================================================
-package yaml_scalar;
-@yaml_scalar::ISA = qw(YAML::Node);
-
-sub new {
- my ($class, $self) = @_;
- tie $_[2], $class, $self;
-}
-
-sub TIESCALAR {
- my ($class, $self) = @_;
- bless $self, $class;
- $self
-}
-
-sub FETCH {
- my ($self) = @_;
- $self->{NODE}
-}
-
-sub STORE {
- my ($self, $value) = @_;
- $self->{NODE} = $value
-}
-
-#==============================================================================
-package yaml_sequence;
-@yaml_sequence::ISA = qw(YAML::Node);
-
-sub new {
- my ($class, $self) = @_;
- my $new;
- tie @$new, $class, $self;
- $new
-}
-
-sub TIEARRAY {
- my ($class, $self) = @_;
- bless $self, $class
-}
-
-sub FETCHSIZE {
- my ($self) = @_;
- scalar @{$self->{NODE}};
-}
-
-sub FETCH {
- my ($self, $index) = @_;
- $self->{NODE}[$index]
-}
-
-sub STORE {
- my ($self, $index, $value) = @_;
- $self->{NODE}[$index] = $value
-}
-
-sub undone {
- die "Not implemented yet"; # XXX
-}
-
-*STORESIZE = *POP = *PUSH = *SHIFT = *UNSHIFT = *SPLICE = *DELETE = *EXISTS =
-*STORESIZE = *POP = *PUSH = *SHIFT = *UNSHIFT = *SPLICE = *DELETE = *EXISTS =
-*undone; # XXX Must implement before release
-
-#==============================================================================
-package yaml_mapping;
-@yaml_mapping::ISA = qw(YAML::Node);
-
-sub new {
- my ($class, $self) = @_;
- @{$self->{KEYS}} = sort keys %{$self->{NODE}};
- my $new;
- tie %$new, $class, $self;
- $new
-}
-
-sub TIEHASH {
- my ($class, $self) = @_;
- bless $self, $class
-}
-
-sub FETCH {
- my ($self, $key) = @_;
- if (exists $self->{NODE}{$key}) {
- return (grep {$_ eq $key} @{$self->{KEYS}})
- ? $self->{NODE}{$key} : undef;
- }
- return $self->{HASH}{$key};
-}
-
-sub STORE {
- my ($self, $key, $value) = @_;
- if (exists $self->{NODE}{$key}) {
- $self->{NODE}{$key} = $value;
- }
- elsif (exists $self->{HASH}{$key}) {
- $self->{HASH}{$key} = $value;
- }
- else {
- if (not grep {$_ eq $key} @{$self->{KEYS}}) {
- push(@{$self->{KEYS}}, $key);
- }
- $self->{HASH}{$key} = $value;
- }
- $value
-}
-
-sub DELETE {
- my ($self, $key) = @_;
- my $return;
- if (exists $self->{NODE}{$key}) {
- $return = $self->{NODE}{$key};
- }
- elsif (exists $self->{HASH}{$key}) {
- $return = delete $self->{NODE}{$key};
- }
- for (my $i = 0; $i < @{$self->{KEYS}}; $i++) {
- if ($self->{KEYS}[$i] eq $key) {
- splice(@{$self->{KEYS}}, $i, 1);
- }
- }
- return $return;
-}
-
-sub CLEAR {
- my ($self) = @_;
- @{$self->{KEYS}} = ();
- %{$self->{HASH}} = ();
-}
-
-sub FIRSTKEY {
- my ($self) = @_;
- $self->{ITER} = 0;
- $self->{KEYS}[0]
-}
-
-sub NEXTKEY {
- my ($self) = @_;
- $self->{KEYS}[++$self->{ITER}]
-}
-
-sub EXISTS {
- my ($self, $key) = @_;
- exists $self->{NODE}{$key}
-}
-
-1;
-
-__END__
-
-=head1 NAME
-
-YAML::Node - A generic data node that encapsulates YAML information
-
-=head1 SYNOPSIS
-
- use YAML;
- use YAML::Node;
-
- my $ynode = YAML::Node->new({}, 'ingerson.com/fruit');
- %$ynode = qw(orange orange apple red grape green);
- print Dump $ynode;
-
-yields:
-
- --- !ingerson.com/fruit
- orange: orange
- apple: red
- grape: green
-
-=head1 DESCRIPTION
-
-A generic node in YAML is similar to a plain hash, array, or scalar node
-in Perl except that it must also keep track of its type. The type is a
-URI called the YAML type tag.
-
-YAML::Node is a class for generating and manipulating these containers.
-A YAML node (or ynode) is a tied hash, array or scalar. In most ways it
-behaves just like the plain thing. But you can assign and retrieve and
-YAML type tag URI to it. For the hash flavor, you can also assign the
-order that the keys will be retrieved in. By default a ynode will offer
-its keys in the same order that they were assigned.
-
-YAML::Node has a class method call new() that will return a ynode. You
-pass it a regular node and an optional type tag. After that you can
-use it like a normal Perl node, but when you YAML::Dump it, the magical
-properties will be honored.
-
-This is how you can control the sort order of hash keys during a YAML
-serialization. By default, YAML sorts keys alphabetically. But notice
-in the above example that the keys were Dumped in the same order they
-were assigned.
-
-YAML::Node exports a function called ynode(). This function returns the tied object so that you can call special methods on it like ->keys().
-
-keys() works like this:
-
- use YAML;
- use YAML::Node;
-
- %$node = qw(orange orange apple red grape green);
- $ynode = YAML::Node->new($node);
- ynode($ynode)->keys(['grape', 'apple']);
- print Dump $ynode;
-
-produces:
-
- ---
- grape: green
- apple: red
-
-It tells the ynode which keys and what order to use.
-
-ynodes will play a very important role in how programs use YAML. They
-are the foundation of how a Perl class can marshall the Loading and
-Dumping of its objects.
-
-The upcoming versions of YAML.pm will have much more information on this.
-
-=head1 AUTHOR
-
-Ingy döt Net <ingy@cpan.org>
-
-=head1 COPYRIGHT
-
-Copyright (c) 2006. Ingy döt Net. All rights reserved.
-
-Copyright (c) 2002. Brian Ingerson. All rights reserved.
-
-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/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/YAML/Tag.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/YAML/Tag.pm
deleted file mode 100644
index a6826fd94d4..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/YAML/Tag.pm
+++ /dev/null
@@ -1,48 +0,0 @@
-package YAML::Tag;
-use strict; use warnings;
-
-use overload '""' => sub { ${$_[0]} };
-
-sub new {
- my ($class, $self) = @_;
- bless \$self, $class
-}
-
-sub short {
- ${$_[0]}
-}
-
-sub canonical {
- ${$_[0]}
-}
-
-1;
-
-__END__
-
-=head1 NAME
-
-YAML::Tag - Tag URI object class for YAML
-
-=head1 SYNOPSIS
-
- use YAML::Tag;
-
-=head1 DESCRIPTION
-
-Used by YAML::Node.
-
-=head1 AUTHOR
-
-Ingy döt Net <ingy@cpan.org>
-
-=head1 COPYRIGHT
-
-Copyright (c) 2006. Ingy döt Net. All rights reserved.
-
-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/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/YAML/Types.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/YAML/Types.pm
deleted file mode 100644
index a5bbb3e27a9..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/YAML/Types.pm
+++ /dev/null
@@ -1,251 +0,0 @@
-package YAML::Types;
-use strict; use warnings;
-use YAML::Base; use base 'YAML::Base';
-use YAML::Node;
-
-# XXX These classes and their APIs could still use some refactoring,
-# but at least they work for now.
-#-------------------------------------------------------------------------------
-package YAML::Type::blessed;
-use YAML::Base; # XXX
-sub yaml_dump {
- my $self = shift;
- my ($value) = @_;
- my ($class, $type) = YAML::Base->node_info($value);
- no strict 'refs';
- my $kind = lc($type) . ':';
- my $tag = ${$class . '::ClassTag'} ||
- "!perl/$kind$class";
- if ($type eq 'REF') {
- YAML::Node->new(
- {(&YAML::VALUE, ${$_[0]})}, $tag
- );
- }
- elsif ($type eq 'SCALAR') {
- $_[1] = $$value;
- YAML::Node->new($_[1], $tag);
- } else {
- YAML::Node->new($value, $tag);
- }
-}
-
-#-------------------------------------------------------------------------------
-package YAML::Type::undef;
-sub yaml_dump {
- my $self = shift;
-}
-
-sub yaml_load {
- my $self = shift;
-}
-
-#-------------------------------------------------------------------------------
-package YAML::Type::glob;
-sub yaml_dump {
- my $self = shift;
- my $ynode = YAML::Node->new({}, '!perl/glob:');
- for my $type (qw(PACKAGE NAME SCALAR ARRAY HASH CODE IO)) {
- my $value = *{$_[0]}{$type};
- $value = $$value if $type eq 'SCALAR';
- if (defined $value) {
- if ($type eq 'IO') {
- my @stats = qw(device inode mode links uid gid rdev size
- atime mtime ctime blksize blocks);
- undef $value;
- $value->{stat} = YAML::Node->new({});
- map {$value->{stat}{shift @stats} = $_} stat(*{$_[0]});
- $value->{fileno} = fileno(*{$_[0]});
- {
- local $^W;
- $value->{tell} = tell(*{$_[0]});
- }
- }
- $ynode->{$type} = $value;
- }
- }
- return $ynode;
-}
-
-sub yaml_load {
- my $self = shift;
- my ($node, $class, $loader) = @_;
- my ($name, $package);
- if (defined $node->{NAME}) {
- $name = $node->{NAME};
- delete $node->{NAME};
- }
- else {
- $loader->warn('YAML_LOAD_WARN_GLOB_NAME');
- return undef;
- }
- if (defined $node->{PACKAGE}) {
- $package = $node->{PACKAGE};
- delete $node->{PACKAGE};
- }
- else {
- $package = 'main';
- }
- no strict 'refs';
- if (exists $node->{SCALAR}) {
- *{"${package}::$name"} = \$node->{SCALAR};
- delete $node->{SCALAR};
- }
- for my $elem (qw(ARRAY HASH CODE IO)) {
- if (exists $node->{$elem}) {
- if ($elem eq 'IO') {
- $loader->warn('YAML_LOAD_WARN_GLOB_IO');
- delete $node->{IO};
- next;
- }
- *{"${package}::$name"} = $node->{$elem};
- delete $node->{$elem};
- }
- }
- for my $elem (sort keys %$node) {
- $loader->warn('YAML_LOAD_WARN_BAD_GLOB_ELEM', $elem);
- }
- return *{"${package}::$name"};
-}
-
-#-------------------------------------------------------------------------------
-package YAML::Type::code;
-my $dummy_warned = 0;
-my $default = '{ "DUMMY" }';
-sub yaml_dump {
- my $self = shift;
- my $code;
- my ($dumpflag, $value) = @_;
- my ($class, $type) = YAML::Base->node_info($value);
- my $tag = "!perl/code";
- $tag .= ":$class" if defined $class;
- if (not $dumpflag) {
- $code = $default;
- }
- else {
- bless $value, "CODE" if $class;
- eval { use B::Deparse };
- return if $@;
- my $deparse = B::Deparse->new();
- eval {
- local $^W = 0;
- $code = $deparse->coderef2text($value);
- };
- if ($@) {
- warn YAML::YAML_DUMP_WARN_DEPARSE_FAILED() if $^W;
- $code = $default;
- }
- bless $value, $class if $class;
- chomp $code;
- $code .= "\n";
- }
- $_[2] = $code;
- YAML::Node->new($_[2], $tag);
-}
-
-sub yaml_load {
- my $self = shift;
- my ($node, $class, $loader) = @_;
- if ($loader->load_code) {
- my $code = eval "package main; sub $node";
- if ($@) {
- $loader->warn('YAML_LOAD_WARN_PARSE_CODE', $@);
- return sub {};
- }
- else {
- CORE::bless $code, $class if $class;
- return $code;
- }
- }
- else {
- return CORE::bless sub {}, $class if $class;
- return sub {};
- }
-}
-
-#-------------------------------------------------------------------------------
-package YAML::Type::ref;
-sub yaml_dump {
- my $self = shift;
- YAML::Node->new({(&YAML::VALUE, ${$_[0]})}, '!perl/ref')
-}
-
-sub yaml_load {
- my $self = shift;
- my ($node, $class, $loader) = @_;
- $loader->die('YAML_LOAD_ERR_NO_DEFAULT_VALUE', 'ptr')
- unless exists $node->{&YAML::VALUE};
- return \$node->{&YAML::VALUE};
-}
-
-#-------------------------------------------------------------------------------
-package YAML::Type::regexp;
-# XXX Be sure to handle blessed regexps (if possible)
-sub yaml_dump {
- die "YAML::Type::regexp::yaml_dump not currently implemented";
-}
-
-use constant _QR_TYPES => {
- '' => sub { qr{$_[0]} },
- x => sub { qr{$_[0]}x },
- i => sub { qr{$_[0]}i },
- s => sub { qr{$_[0]}s },
- m => sub { qr{$_[0]}m },
- ix => sub { qr{$_[0]}ix },
- sx => sub { qr{$_[0]}sx },
- mx => sub { qr{$_[0]}mx },
- si => sub { qr{$_[0]}si },
- mi => sub { qr{$_[0]}mi },
- ms => sub { qr{$_[0]}sm },
- six => sub { qr{$_[0]}six },
- mix => sub { qr{$_[0]}mix },
- msx => sub { qr{$_[0]}msx },
- msi => sub { qr{$_[0]}msi },
- msix => sub { qr{$_[0]}msix },
-};
-sub yaml_load {
- my $self = shift;
- my ($node, $class) = @_;
- return qr{$node} unless $node =~ /^\(\?([\-xism]*):(.*)\)\z/s;
- my ($flags, $re) = ($1, $2);
- $flags =~ s/-.*//;
- my $sub = _QR_TYPES->{$flags} || sub { qr{$_[0]} };
- my $qr = &$sub($re);
- bless $qr, $class if length $class;
- return $qr;
-}
-
-1;
-
-__END__
-
-=head1 NAME
-
-YAML::Types - Marshall Perl internal data types to/from YAML
-
-=head1 SYNOPSIS
-
- $::foo = 42;
- print YAML::Dump(*::foo);
-
- print YAML::Dump(qr{match me});
-
-=head1 DESCRIPTION
-
-This module has the helper classes for transferring objects,
-subroutines, references, globs, regexps and file handles to and
-from YAML.
-
-=head1 AUTHOR
-
-Ingy döt Net <ingy@cpan.org>
-
-=head1 COPYRIGHT
-
-Copyright (c) 2006. Ingy döt Net. All rights reserved.
-
-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/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/auto/Tee/ptee b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/auto/Tee/ptee
deleted file mode 100644
index 4c3544c249a..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/auto/Tee/ptee
+++ /dev/null
@@ -1,157 +0,0 @@
-#!/usr/bin/perl
-
-# ptee -- perl implementation of unix tee
-$VERSION = "0.13";
-use strict;
-use File::Basename qw/basename/;
-use Getopt::Long;
-use IO::File;
-
-=head1 NAME
-
-ptee - emulate the GNU tee program with Perl
-
-=cut
-
-my $help_text = <<'=cut';
-
-=head1 SYNOPSIS
-
- ptee [OPTIONS]... [FILENAMES]...
-
- OPTIONS:
-
- --append or -a
- append to file(s) rather than overwrite
-
- --help or -h
- give usage information
-
- --version or -V
- print the version number of this program
-
-=cut
-
-$help_text =~ s/\A.+?( ptee.*)/$1/ms;
-
-#--------------------------------------------------------------------------#
-# process command line
-#--------------------------------------------------------------------------#
-
-my %opts;
-GetOptions( \%opts,
- 'version|V',
- 'help|h|?',
- 'append|a',
-);
-
-#--------------------------------------------------------------------------#
-# options
-#--------------------------------------------------------------------------#
-
-if ($opts{version}) {
- print basename($0), " $main::VERSION\n";
- exit 0;
-}
-
-if ($opts{help}) {
- print "Usage:\n$help_text";
- exit 1;
-}
-
-my $mode = $opts{append} ? ">>" : ">";
-
-#--------------------------------------------------------------------------#
-# Setup list of filehandles
-#--------------------------------------------------------------------------#
-
-my $stdout = IO::Handle->new->fdopen(fileno(STDOUT),"w");
-my @files = $stdout;
-
-for my $file ( @ARGV ) {
- my $f = IO::File->new("$mode $file")
- or die "Could't open '$file' for writing: $!'";
- push @files, $f;
-}
-
-#--------------------------------------------------------------------------#
-# Tee input to the filehandle list
-#--------------------------------------------------------------------------#
-
-my $buffer_size = 1024;
-my $buffer;
-
-while ( sysread( STDIN, $buffer, $buffer_size ) > 0 ) {
- for my $fh ( @files ) {
- syswrite $fh, $buffer;
- }
-}
-
-__END__
-
-=head1 DESCRIPTION
-
-C<ptee> is a pure Perl emulation of the standard GNU tool C<tee> and is
-designed to be a platform independent replacement for operating systems without
-a native C<tee> program.
-
-It passes input received on STDIN through to STDOUT while also writing a copy
-of the input to any files provided as arguments. By default, files will be
-overwritten, but this behavior may be altered with the C<--append> option.
-
-Unlike C<tee>, C<ptee> does not support ignoring interrupts, as signal handling
-is not sufficiently portable.
-
-=head1 BUGS
-
-Please report any bugs or feature using the CPAN Request Tracker.
-Bugs can be submitted by email to C<bug-Tee@rt.cpan.org> or
-through the web interface at
-L<http:E<sol>E<sol>rt.cpan.orgE<sol>PublicE<sol>DistE<sol>Display.html?Name=Tee>
-
-When submitting a bug or request, please include a test-file or a patch to an
-existing test-file that illustrates the bug or desired feature.
-
-=head1 AUTHOR
-
-David A. Golden (DAGOLDEN)
-
-dagolden@cpan.org
-
-http:E<sol>E<sol>www.dagolden.orgE<sol>
-
-=head1 COPYRIGHT AND LICENSE
-
-Copyright (c) 2006 by David A. Golden
-
-This program is free software; you can redistribute
-it andE<sol>or modify it under the same terms as Perl itself.
-
-The full text of the license can be found in the
-LICENSE file included with this module.
-
-=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 ANDE<sol>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 ANDE<sol>OR
-REDISTRIBUTE THE SOFTWARE AS PERMITTED BY THE ABOVE LICENCE, 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.
-
-
-
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Alias.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Alias.pm
deleted file mode 100644
index 50c85f0fa59..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Alias.pm
+++ /dev/null
@@ -1,370 +0,0 @@
-#
-# Documentation at the __END__
-#
-
-package Alias;
-
-require 5.004;
-require Exporter;
-require DynaLoader;
-
-@ISA = qw(Exporter DynaLoader);
-@EXPORT = qw(alias attr);
-@EXPORT_OK = qw(const);
-
-$VERSION = $VERSION = '2.32';
-
-use Carp;
-
-bootstrap Alias;
-
-$Alias::KeyFilter = "";
-$Alias::AttrPrefix = "";
-$Alias::Deref = ""; # don't deref objects
-
-sub alias {
- croak "Need even number of args" if @_ % 2;
- my($pkg) = caller; # for namespace soundness
- while (@_) {
- # *foo = \*bar works in 5.002
- *{"$pkg\:\:$_[0]"} = (defined($_[1]) and ref($_[1])) ? $_[1] : \$_[1];
- shift; shift;
- }
-}
-
-# alias the elements of hashref
-# same as alias %{$_[0]}, but also localizes the aliases and
-# returns the hashref
-sub attr;
-
-alias const => \&alias; # alias the alias :-)
-
-
-1;
-__END__
-
-=head1 NAME
-
-alias - declare symbolic aliases for perl data
-
-attr - auto-declare hash attributes for convenient access
-
-const - define compile-time scalar constants
-
-
-=head1 SYNOPSIS
-
- use Alias qw(alias const attr);
- alias TEN => $ten, Ten => \$ten, Ten => \&ten,
- Ten => \@ten, Ten => \%ten, TeN => \*ten;
- {
- local @Ten;
- my $ten = [1..10];
- alias Ten => $ten; # local @Ten
- }
-
- const pi => 3.14, ten => 10;
-
- package Foo;
- use Alias;
- sub new { bless {foo => 1, _bar => [2, 3]}, $_[0] }
- sub a_method {
- my $s = attr shift;
- # $foo, @_bar are now local aliases for
- # $_[0]{foo}, @{$_[0]{_bar}} etc.
- }
-
- sub b_method {
- local $Alias::KeyFilter = "_";
- local $Alias::AttrPrefix = "main::";
- my $s = attr shift;
- # local @::_bar is now available, ($foo, $::foo are not)
- }
-
- sub c_method {
- local $Alias::KeyFilter = sub { $_ = shift; return (/^_/ ? 1 : 0) };
- local $Alias::AttrPrefix = sub {
- $_ = shift;
- s/^_(.+)$/main::$1/;
- return $_
- };
- my $s = attr shift;
- # local @::bar is now available, ($foo, $::foo are not)
- }
-
-
-=head1 DESCRIPTION
-
-Provides general mechanisms for aliasing perl data for convenient access.
-
-This module works by putting some values on the symbol table with
-user-supplied names. Values that are references will get dereferenced into
-their base types. This means that a value of C<[1,2,3]> with a name of
-"foo" will be made available as C<@foo>, not C<$foo>.
-
-The exception to this rule is the default behavior of the C<attr> function,
-which will not dereference values which are blessed references (aka
-objects). See L<$Alias::Deref> for how to change this default behavior.
-
-=head2 Functions
-
-=over 4
-
-=item alias
-
-Given a list of name => value pairs, declares aliases
-in the C<caller>s namespace. If the value supplied is a reference, the
-alias is created for the underlying value instead of the reference
-itself (there is no need to use this module to alias references--they
-are automatically "aliased" on assignment). This allows the user to
-alias most of the basic types.
-
-If the value supplied is a scalar compile-time constant, the aliases
-become read-only. Any attempt to write to them will fail with a run time
-error.
-
-Aliases can be dynamically scoped by pre-declaring the target variable as
-C<local>. Using C<attr> for this purpose is more convenient, and
-recommended.
-
-=item attr
-
-Given a hash reference, aliases the values of the hash to the names that
-correspond to the keys. It always returns the supplied value. The aliases
-are local to the enclosing block. If any of the values are unblessed
-references, they are available as their dereferenced types. Thus the action
-is similar to saying:
-
- alias %{$_[0]}
-
-but, in addition, also localizes the aliases, and does not dereference
-objects. Dereferencing of objects can be forced by setting the C<Deref>
-option. See L<$Alias::Deref>.
-
-This can be used for convenient access to hash values and hash-based object
-attributes.
-
-Note that this makes available the semantics of C<local> subroutines and
-methods. That makes for some nifty possibilities. We could make truly
-private methods by putting anonymous subs within an object. These subs
-would be available within methods where we use C<attr>, and will not
-be visible to the outside world as normal methods. We could forbid
-recursion in methods by always putting an empty sub in the object hash
-with the same key as the method name. This would be useful where a method
-has to run code from other modules, but cannot be certain whether that
-module will call it back again.
-
-The default behavior is to create aliases for all the entries in the hash,
-in the callers namespace. This can be controlled by setting a few options.
-See L<Configuration Variables> for details.
-
-=item const
-
-This is simply a function alias for C<alias>, described above. Provided on
-demand at C<use> time, since it reads better for constant declarations.
-Note that hashes and arrays cannot be so C<const>rained.
-
-=back
-
-=head2 Configuration Variables
-
-The following configuration variables can be used to control the behavior of
-the C<attr> function. They are typically set after the C<use Alias;>
-statement. Another typical usage is to C<local>ize them in a block so that
-their values are only effective within that block.
-
-=over 4
-
-=item $Alias::KeyFilter
-
-Specifies the key prefix used for determining which hash entries will be
-interned by C<attr>. Can be a CODE reference, in which case it will be
-called with the key, and the boolean return value will determine if
-that hash entry is a candidate attribute.
-
-=item $Alias::AttrPrefix
-
-Specifies a prefix to prepend to the names of localized attributes created
-by C<attr>. Can be a CODE reference, in which case it will be called with
-the key, and the result will determine the full name of the attribute. The
-value can have embedded package delimiters ("::" or "'"), which cause the
-attributes to be interned in that namespace instead of the C<caller>s own
-namespace. For example, setting it to "main::" makes C<use strict 'vars';>
-somewhat more palatable (since we can refer to the attributes as C<$::foo>,
-etc., without actually declaring the attributes).
-
-=item $Alias::Deref
-
-Controls the implicit dereferencing behavior of C<attr>. If it is set to
-"" or 0, C<attr> will not dereference blessed references. If it is a true
-value (anything but "", 0, or a CODE reference), all references will be
-made available as their dereferenced types, including values that may be
-objects. The default is "".
-
-This option can be used as a filter if it is set to a CODE reference, in
-which case it will be called with the key and the value (whenever the value
-happens to be a reference), and the boolean return value will determine if
-that particular reference must be dereferenced.
-
-
-=back
-
-=head2 Exports
-
-=over 4
-
-=item alias
-
-=item attr
-
-=back
-
-=head1 EXAMPLES
-
-Run these code snippets and observe the results to become more familiar
-with the features of this module.
-
- use Alias qw(alias const attr);
- $ten = 10;
- alias TEN => $ten, Ten => \$ten, Ten => \&ten,
- Ten => \@ten, Ten => \%ten;
- alias TeN => \*ten; # same as *TeN = *ten
-
- # aliasing basic types
- $ten = 20;
- print "$TEN|$Ten|$ten\n"; # should print "20|20|20"
- sub ten { print "10\n"; }
- @ten = (1..10);
- %ten = (a..j);
- &Ten; # should print "10"
- print @Ten, "|", %Ten, "\n";
-
- # this will fail at run time
- const _TEN_ => 10;
- eval { $_TEN_ = 20 };
- print $@ if $@;
-
- # dynamically scoped aliases
- @DYNAMIC = qw(m n o);
- {
- my $tmp = [ qw(a b c d) ];
- local @DYNAMIC;
- alias DYNAMIC => $tmp, PERM => $tmp;
-
- $DYNAMIC[2] = 'zzz';
- # prints "abzzzd|abzzzd|abzzzd"
- print @$tmp, "|", @DYNAMIC, "|", @PERM, "\n";
-
- @DYNAMIC = qw(p q r);
- # prints "pqr|pqr|pqr"
- print @$tmp, "|", @DYNAMIC, "|", @PERM, "\n";
- }
-
- # prints "mno|pqr"
- print @DYNAMIC, "|", @PERM, "\n";
-
- # named closures
- my($lex) = 'abcd';
- $closure = sub { print $lex, "\n" };
- alias NAMEDCLOSURE => \&$closure;
- NAMEDCLOSURE(); # prints "abcd"
- $lex = 'pqrs';
- NAMEDCLOSURE(); # prints "pqrs"
-
- # hash/object attributes
- package Foo;
- use Alias;
- sub new {
- bless
- { foo => 1,
- bar => [2,3],
- buz => { a => 4},
- privmeth => sub { "private" },
- easymeth => sub { die "to recurse or to die, is the question" },
- }, $_[0];
- }
-
- sub easymeth {
- my $s = attr shift; # localizes $foo, @bar, %buz etc with values
- eval { $s->easymeth }; # should fail
- print $@ if $@;
-
- # prints "1|2|3|a|4|private|"
- print join '|', $foo, @bar, %buz, $s->privmeth, "\n";
- }
-
- $foo = 6;
- @bar = (7,8);
- %buz = (b => 9);
- Foo->new->easymeth; # this will not recurse endlessly
-
- # prints "6|7|8|b|9|"
- print join '|', $foo, @bar, %buz, "\n";
-
- # this should fail at run-time
- eval { Foo->new->privmeth };
- print $@ if $@;
-
-
-=head1 NOTES
-
-It is worth repeating that the aliases created by C<alias> and C<const> will
-be created in the C<caller>s namespace (we can use the C<AttrPrefix> option to
-specify a different namespace for C<attr>). If that namespace happens to be
-C<local>ized, the aliases created will be local to that block. C<attr>
-localizes the aliases for us.
-
-Remember that references will be available as their dereferenced types.
-
-Aliases cannot be lexical, since, by neccessity, they live on the
-symbol table.
-
-Lexicals can be aliased. Note that this provides a means of reversing the
-action of anonymous type generators C<\>, C<[]> and C<{}>. This allows us
-to anonymously construct data or code and give it a symbol-table presence
-when we choose.
-
-Any occurrence of C<::> or C<'> in names will be treated as package
-qualifiers, and the value will be interned in that namespace.
-
-Remember that aliases are very much like references, only we don't
-have to dereference them as often. Which means we won't have to
-pound on the dollars so much.
-
-We can dynamically make subroutines and named closures with this scheme.
-
-It is possible to alias packages, but that might be construed as
-abuse.
-
-Using this module will dramatically reduce noise characters in
-object-oriented perl code.
-
-
-=head1 BUGS
-
-C<use strict 'vars';> is not very usable, since we B<depend> so much
-on the symbol table. You can declare the attributes with C<use vars> to
-avoid warnings. Setting C<$Alias::AttrPrefix> to "main::" is one way
-to avoid C<use vars> and frustration.
-
-Tied variables cannot be aliased properly, yet.
-
-
-=head1 VERSION
-
-Version 2.32 30 Apr 1999
-
-
-=head1 AUTHOR
-
-Gurusamy Sarathy gsar@umich.edu
-
-Copyright (c) 1995-99 Gurusamy Sarathy. 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
-
-perl(1)
-
-=cut
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Compress/Bzip2.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Compress/Bzip2.pm
deleted file mode 100644
index f7ffb0541a1..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Compress/Bzip2.pm
+++ /dev/null
@@ -1,1579 +0,0 @@
-# File : Bzip2.pm
-# Author : Rob Janes
-# Created : 14 April 2005
-# Modified : 9 Aug 2005
-# Version : 2.09
-#
-# Copyright (c) 2005 Rob Janes. All rights reserved.
-# This program is free software; you can redistribute it and/or
-# modify it under the same terms as Perl itself.
-#
-
-package Compress::Bzip2;
-
-use 5.006;
-
-use strict;
-use warnings;
-
-use Carp;
-use Getopt::Std;
-use Fcntl qw(:DEFAULT :mode);
-
-require Exporter;
-use AutoLoader;
-
-our @ISA = qw(Exporter);
-
-# 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.
-
-# This allows declaration use Compress::Bzip2 ':all';
-# If you do not need this, moving things directly into @EXPORT or @EXPORT_OK
-# will save memory.
-our %EXPORT_TAGS =
- ( 'constants' => [ qw(
- BZ_CONFIG_ERROR
- BZ_DATA_ERROR
- BZ_DATA_ERROR_MAGIC
- BZ_FINISH
- BZ_FINISH_OK
- BZ_FLUSH
- BZ_FLUSH_OK
- BZ_IO_ERROR
- BZ_MAX_UNUSED
- BZ_MEM_ERROR
- BZ_OK
- BZ_OUTBUFF_FULL
- BZ_PARAM_ERROR
- BZ_RUN
- BZ_RUN_OK
- BZ_SEQUENCE_ERROR
- BZ_STREAM_END
- BZ_UNEXPECTED_EOF
- ) ],
-
- 'utilities' => [ qw(
- &bzopen
- &bzinflateInit
- &bzdeflateInit
- &memBzip &memBunzip
- &compress &decompress
- &bzip2 &bunzip2
- &bzlibversion
- $bzerrno
- ) ],
-
- 'bzip1' => [ qw(
- &compress
- &decompress
- &compress_init
- &decompress_init
- &version
- ) ],
-
- 'gzip' => [ qw(
- &gzopen
- &inflateInit
- &deflateInit
- &compress &uncompress
- &adler32 &crc32
-
- ZLIB_VERSION
-
- $gzerrno
-
- Z_OK
- Z_STREAM_END
- Z_NEED_DICT
- Z_ERRNO
- Z_STREAM_ERROR
- Z_DATA_ERROR
- Z_MEM_ERROR
- Z_BUF_ERROR
- Z_VERSION_ERROR
-
- Z_NO_FLUSH
- Z_PARTIAL_FLUSH
- Z_SYNC_FLUSH
- Z_FULL_FLUSH
- Z_FINISH
- Z_BLOCK
-
- Z_NO_COMPRESSION
- Z_BEST_SPEED
- Z_BEST_COMPRESSION
- Z_DEFAULT_COMPRESSION
-
- Z_FILTERED
- Z_HUFFMAN_ONLY
- Z_RLE
- Z_DEFAULT_STRATEGY
-
- Z_BINARY
- Z_ASCII
- Z_UNKNOWN
-
- Z_DEFLATED
- Z_NULL
- ) ],
- );
-
-our @EXPORT_OK = ( @{ $EXPORT_TAGS{'utilities'} },
- @{ $EXPORT_TAGS{'constants'} },
- @{ $EXPORT_TAGS{'bzip1'} },
- @{ $EXPORT_TAGS{'gzip'} },
- );
-
-$EXPORT_TAGS{'all'} = [ @EXPORT_OK ];
-
-our @EXPORT = ( @{ $EXPORT_TAGS{'utilities'} }, @{ $EXPORT_TAGS{'constants'} } );
-
-our $VERSION = "2.09";
-
-our $bzerrno = "";
-our $gzerrno;
-*gzerrno = \$bzerrno;
-
-# Zlib compatibility
-##
-use constant ZLIB_VERSION => '1.x';
-# allowed flush values
-use constant { Z_NO_FLUSH => 0, Z_PARTIAL_FLUSH => 1, Z_SYNC_FLUSH => 2,
- Z_FULL_FLUSH => 3, Z_FINISH => 4, Z_BLOCK => 5 };
-# return codes for functions, positive normal, negative error
-use constant { Z_OK => 0, Z_STREAM_END => 1, Z_NEED_DICT => 2, Z_ERRNO => -1,
- Z_STREAM_ERROR => -2, Z_DATA_ERROR => -3, Z_MEM_ERROR => -4,
- Z_BUF_ERROR => -5, Z_VERSION_ERROR => -6 };
-# compression levels
-use constant { Z_NO_COMPRESSION => 0, Z_BEST_SPEED => 1,
- Z_BEST_COMPRESSION => 9, Z_DEFAULT_COMPRESSION => -1 };
-# compression strategy, for deflateInit
-use constant { Z_FILTERED => 1, Z_HUFFMAN_ONLY => 2, Z_RLE => 3,
- Z_DEFAULT_STRATEGY => 0 };
-# possible values of data_type (inflate)
-use constant { Z_BINARY => 0, Z_ASCII => 1, Z_UNKNOWN => 2 };
-# the deflate compression method
-use constant Z_DEFLATED => 8;
-# for initialization
-use constant Z_NULL => 0;
-
-## gzopen, $gzerror, gzerror, gzclose, gzreadline, gzwrite
-
-sub AUTOLOAD {
- # This AUTOLOAD is used to 'autoload' constants from the constant()
- # XS function.
-
- my $constname;
- our $AUTOLOAD;
- ($constname = $AUTOLOAD) =~ s/.*:://;
- croak "&Compress::Bzip2::constant not defined" if $constname eq 'constant';
- my ($error, $val) = constant($constname);
- if ($error) { croak $error; }
- {
- no strict 'refs';
- # Fixed between 5.005_53 and 5.005_61
-#XXX if ($] >= 5.00561) {
-#XXX *$AUTOLOAD = sub () { $val };
-#XXX }
-#XXX else {
- *$AUTOLOAD = sub { $val };
-#XXX }
- }
- goto &$AUTOLOAD;
-}
-
-require XSLoader;
-XSLoader::load('Compress::Bzip2', $VERSION);
-
-#bootstrap Compress::Bzip2 $VERSION;
-
-##############################################################################
-## file compress uncompress commands
-
-sub _writefileopen ( $$;$ ) {
- ## open a protected file for write
- my ( $handle, $filename, $force ) = @_;
-
- if ( sysopen($handle, $filename, $force ? O_WRONLY|O_CREAT|O_TRUNC : O_WRONLY|O_CREAT|O_EXCL, S_IWUSR|S_IRUSR) ) {
- $_[0] = $handle if !defined($_[0]);
- return $handle;
- }
-
- return undef;
-}
-
-sub _stat_snapshot ( $ ) {
- my ( $filename ) = @_;
- return undef if !defined($filename);
-
- my @stats = stat $filename;
- if (!@stats) {
- warn "stat of $filename failed: $!\n" if !@stats;
- return undef;
- }
-
- return \@stats;
-}
-
-sub _check_stat ( $$;$ ) {
- my ( $filename, $statsnap, $force ) = @_;
-
- if ( !defined($statsnap) || (ref($statsnap) eq 'ARRAY' && @$statsnap == 0) ) {
- $statsnap = _stat_snapshot( $filename );
- if ( $statsnap ) {
- if ( @_>1 ) {
- if ( !defined($_[1]) ) {
- $_[1] = $statsnap;
- }
- elsif ( ref($_[1]) eq 'ARRAY' && @{ $_[1] } == 0 ) {
- @{ $_[1] } = @$statsnap;
- }
- }
- }
- else {
- return undef;
- }
- }
-
- if ( S_ISDIR( $statsnap->[2] ) ) {
- bz_seterror( &BZ_IO_ERROR, "file $filename is a directory" );
- return 0;
- }
-
- if ( !S_ISREG( $statsnap->[2] ) ) {
- bz_seterror( &BZ_IO_ERROR, "file $filename is not a normal file" );
- return 0;
- }
-
- if ( !$force && S_ISLNK( $statsnap->[2] ) ) {
- bz_seterror( &BZ_IO_ERROR, "file $filename is a symlink" );
- return 0;
- }
-
- if ( !$force && $statsnap->[3] > 1 ) {
- bz_seterror( &BZ_IO_ERROR, "file $filename has too many hard links" );
- return 0;
- }
-
- return 1;
-}
-
-sub _set_stat_from_snapshot ( $$ ) {
- my ( $filename, $statsnap ) = @_;
-
- if ( !chmod( S_IMODE( $statsnap->[2] ), $filename ) ) {
- bz_seterror( &BZ_IO_ERROR, "chmod ".sprintf('%03o', S_IMODE( $statsnap->[2] ))." $filename failed: $!" );
- return undef;
- }
-
- if ( !utime @$statsnap[8,9], $filename ) {
- bz_seterror( &BZ_IO_ERROR,
- "utime " . join(' ',map { strftime('%Y-%m-%d %H:%M:%S', localtime $_) } @$statsnap[8,9] ) .
- " $filename failed: $!" );
- return undef;
- }
-
- if ( !chown @$statsnap[4,5], $filename ) {
- bz_seterror( &BZ_IO_ERROR,
- "chown " . join(':', ( getpwuid($statsnap->[4]) )[0], ( getgrgid($statsnap->[5]) )[0]) .
- " $filename failed: $!" );
- return 0;
- }
-
- return 1;
-}
-
-sub bzip2 ( @ ) {
- return _process_files( 'bzip2', 'cfvks123456789', @_ );
-}
-
-sub bunzip2 ( @ ) {
- return _process_files( 'bunzip2', 'cdzfks123456789', @_ );
-}
-
-sub bzcat ( @ ) {
- return _process_files( 'bzcat', 'cdzfks123456789', @_ );
-}
-
-sub _process_files ( @ ) {
- my $command = shift;
- my $opts = shift;
-
- local @ARGV = @_;
-
- my %opts;
- return undef if !getopt( $opts, \%opts );
- # c compress or decompress to stdout
- # d decompress
- # z compress
- # f force
- # v verbose
- # k keep
- # s small
- # 123456789
-
- $opts{c} = 1 if $command eq 'bzcat';
- $opts{d} = 1 if $command eq 'bunzip2' || $command eq 'bzcat';
- $opts{z} = 1 if $command eq 'bzip2';
-
- my $read_from_stdin;
- my ( $in, $bzin );
- my ( $out, $bzout );
-
- if ( !@ARGV ) {
- $read_from_stdin = 1;
- $opts{c} = 1;
- if ( !open( $in, "<&STDIN" ) ) {
- die "Error: failed to input from STDIN: '$!'\n";
- }
-
- $bzin = bzopen( $in, "r" );
- }
-
- if ( $opts{c} ) {
- if ( !open( $out, ">&STDOUT" ) ) {
- die "Error: failed to output to STDOUT: '$!'\n";
- }
-
- $bzout = bzopen( $out, "w" );
- }
-
- if ( !$opts{d} && !$opts{z} ) {
- die "Error: neither compress nor decompress was indicated.\n";
- }
-
- my $doneflag = 0;
- while ( !$doneflag ) {
- my $infile;
- my $outfile;
- my @statbuf;
-
- if ( !$read_from_stdin ) {
- $infile = shift @ARGV;
- if ( ! -r $infile ) {
- print STDERR "Error: file $infile is not readable\n";
- next;
- }
-
- @statbuf = stat _;
- if ( !@statbuf ) {
- print STDERR "Error: failed to stat $infile: '$!'\n";
- next;
- }
-
- if ( !_check_stat( $infile, \@statbuf, $opts{f} ) ) {
- print STDERR "Error: file $infile stat check fails: $bzerrno\n";
- next;
- }
- }
-
- my $outfile_exists;
- if ( !$opts{c} ) {
- undef $out;
- if ( $opts{d} ) {
- $outfile = $infile . '.bz2';
- }
- elsif ( $opts{z} ) {
- $outfile = $infile =~ /\.bz2$/ ? substr($infile,0,-4) : $infile.'.out';
- }
-
- $outfile_exists = -e $outfile;
- if ( !_writefileopen( $out, $outfile, $opts{f} ) ) {
- print STDERR "Error: failed to open $outfile for write: '$!'\n";
- next;
- }
- }
-
- if ( !$read_from_stdin ) {
- undef $in;
- if ( !open( $in, $infile ) ) {
- print STDERR "Error: unable to open $infile: '$!'\n";
- unlink( $outfile ) if !$outfile_exists;
- next;
- }
- }
-
- if ( $opts{d} ) {
- $bzin = bzopen( $in, "r" ) if !$read_from_stdin;
-
- my $buf;
- my $notdone = 1;
- while ( $notdone ) {
- my $ln = bzread( $in, $buf, 1024 );
- if ( $ln > 0 ) {
- syswrite( $out, $buf, $ln );
- }
- elsif ( $ln == 0 ) {
- undef $notdone;
- }
- else {
- }
- }
-
- close($out);
-
- if ( !$read_from_stdin ) {
- bzclose($in);
- unlink( $infile ) if !$opts{k};
- _set_stat_from_snapshot( $outfile, \@statbuf );
- }
- }
- elsif ( $opts{z} ) {
- $bzout = bzopen( $out, "w" ) if !$opts{c};
-
- my $buf;
- my $notdone = 1;
- while ( $notdone ) {
- my $ln = sysread( $in, $buf, 1024 );
- if ( $ln > 0 ) {
- bzwrite( $bzout, $buf, $ln );
- }
- elsif ( $ln == 0 ) {
- undef $notdone;
- }
- else {
- }
- }
-
- close($in);
-
- if ( !$opts{c} ) {
- bzclose($bzout);
- unlink( $infile ) if !$opts{k};
- _set_stat_from_snapshot( $outfile, \@statbuf );
- }
- }
- }
-}
-
-##############################################################################
-##############################################################################
-## compatibility with Compress::Bzip2 1.03
-
-sub add ( $$ ) {
- my ( $obj, $buffer ) = @_;
-
- my @res = $obj->is_write ? $obj->bzdeflate( $buffer ) : $obj->bzinflate( $buffer );
-
- return $res[0];
-}
-
-sub finish ( $;$ ) {
- my ( $obj, $buffer ) = @_;
- my ( @res, $out );
-
- if ( defined($buffer) ) {
- @res = $obj->is_write ? $obj->bzdeflate( $buffer ) : $obj->bzinflate( $buffer );
- return undef if $res[1] != &BZ_OK;
-
- $out = $res[0];
- }
- $out = '' if !defined($out);
-
- @res = $obj->bzclose;
- return undef if $res[1] != &BZ_OK;
-
- return $out.$res[0];
-}
-
-sub input_size ( $ ) {
- my ( $obj ) = @_;
- return $obj->total_in;
-}
-
-sub output_size ( $ ) {
- my ( $obj ) = @_;
- return $obj->total_out;
-}
-
-sub version ( ) {
- return bzlibversion();
-}
-
-sub error ( $ ) {
- return $_[0]->bzerror;
-}
-
-##############################################################################
-##############################################################################
-## THE Compress::Zlib compatibility section
-
-sub _bzerror2gzerror {
- my ( $bz_error_num ) = @_;
- my $gz_error_num =
- $bz_error_num == &BZ_OK ? Z_OK :
- $bz_error_num == &BZ_RUN_OK ? Z_OK :
- $bz_error_num == &BZ_FLUSH_OK ? Z_STREAM_END :
- $bz_error_num == &BZ_FINISH_OK ? Z_STREAM_END :
- $bz_error_num == &BZ_STREAM_END ? Z_STREAM_END :
-
- $bz_error_num == &BZ_SEQUENCE_ERROR ? Z_VERSION_ERROR :
- $bz_error_num == &BZ_PARAM_ERROR ? Z_ERRNO :
- $bz_error_num == &BZ_MEM_ERROR ? Z_MEM_ERROR :
- $bz_error_num == &BZ_DATA_ERROR ? Z_DATA_ERROR :
- $bz_error_num == &BZ_DATA_ERROR_MAGIC ? Z_DATA_ERROR :
- $bz_error_num == &BZ_IO_ERROR ? Z_ERRNO :
- $bz_error_num == &BZ_UNEXPECTED_EOF ? Z_STREAM_ERROR :
- $bz_error_num == &BZ_OUTBUFF_FULL ? Z_BUF_ERROR :
- $bz_error_num == &BZ_CONFIG_ERROR ? Z_VERSION_ERROR :
- Z_VERSION_ERROR
- ;
-
- return $gz_error_num;
-}
-
-sub gzopen ( $$ ) {
- goto &bzopen;
-}
-
-sub gzread ( $$;$ ) {
- goto &bzread;
-}
-
-sub gzreadline ( $$ ) {
- goto &bzreadline;
-}
-
-sub gzwrite ( $$ ) {
- goto &bzwrite;
-}
-
-sub gzflush ( $;$ ) {
- my ( $obj, $flush ) = @_;
- return Z_OK if $flush == Z_NO_FLUSH;
- goto &bzflush;
-}
-
-sub gzclose ( $ ) {
- goto &bzclose;
-}
-
-sub gzeof ( $ ) {
- goto &bzeof;
-}
-
-sub gzsetparams ( $$$ ) {
- ## ignore params
- my ( $obj, $level, $strategy ) = @_;
- return Z_OK;
-}
-
-sub gzerror ( $ ) {
- goto &bzerror;
-}
-
-sub deflateInit ( @ ) {
- ## ignore all options:
- ## -Level, -Method, -WindowBits, -MemLevel, -Strategy, -Dictionary, -Bufsize
-
- my @res = bzdeflateInit();
- return $res[0] if !wantarray;
-
- return ( $res[0], _bzerror2gzerror( $res[1] ) );
-}
-
-sub deflate ( $$ ) {
- my ( $obj, $buffer ) = @_;
-
- my @res = $obj->bzdeflate( $buffer );
-
- return $res[0] if !wantarray;
- return ( $res[0], _bzerror2gzerror( $res[1] ) );
-}
-
-sub deflateParams ( $;@ ) {
- ## ignore all options
- return Z_OK;
-}
-
-sub flush ( $;$ ) {
- my ( $obj, $flush_type ) = @_;
-
- $flush_type = Z_FINISH if !defined($flush_type);
- return Z_OK if $flush_type == Z_NO_FLUSH;
-
- my $bz_flush_type;
- my @res;
-
- $bz_flush_type =
- $flush_type == Z_PARTIAL_FLUSH || $flush_type == Z_SYNC_FLUSH ? &BZ_FLUSH :
- $flush_type == Z_FULL_FLUSH ? &BZ_FINISH :
- &BZ_FINISH;
-
- @res = $obj->bzflush( $bz_flush_type );
-
- return $res[0] if !wantarray;
- return ( $res[0], _bzerror2gzerror( $res[1] ) );
-}
-
-sub dict_adler ( $ ) {
- return 1; # ???
-}
-
-sub msg ( $ ) {
- my ( $obj ) = @_;
-
- return ''.($obj->bzerror).''; # stringify
-}
-
-sub inflateInit ( @ ) {
- ## ignore all options:
- ## -WindowBits, -Dictionary, -Bufsize
-
- my @res = bzinflateInit();
- return $res[0] if !wantarray;
-
- return ( $res[0], _bzerror2gzerror( $res[1] ) );
-}
-
-sub inflate ( $$ ) {
- my ( $obj, $buffer ) = @_;
-
- my @res = $obj->bzinflate( $buffer );
-
- return $res[0] if !wantarray;
- return ( $res[0], _bzerror2gzerror( $res[1] ) );
-}
-
-sub inflateSync ( $ ) {
- return Z_VERSION_ERROR; # ?? what
-}
-
-sub memGzip ( $ ) {
- goto &memBzip;
-}
-
-sub memGunzip ( $ ) {
- goto &memBunzip;
-}
-
-sub adler32 ( $;$ ) {
- return 0;
-}
-
-sub crc32 ( $;$ ) {
- return 0;
-}
-
-# sub compress ( $;$ ) {
-# ## ignore $level
-# my ( $source, $level ) = @_;
-# return memBzip( $source );
-# }
-
-sub uncompress ( $ ) {
- my ( $source, $level ) = @_;
- return memBunzip( $source );
-}
-
-# Autoload methods go after =cut, and are processed by the autosplit program.
-
-1;
-
-__END__
-
-=pod
-
-=head1 NAME
-
-Compress::Bzip2 - Interface to Bzip2 compression library
-
-=head1 SYNOPSIS
-
- use Compress::Bzip2 qw(:all :constant :utilities :gzip);
-
- ($bz, $status) = bzdeflateInit( [PARAMS] ) ;
- ($out, $status) = $bz->bzdeflate($buffer) ;
-
- ($bz, $status) = bzinflateInit( [PARAMS] ) ;
- ($out, $status) = $bz->bzinflate($buffer) ;
-
- ($out, $status) = $bz->bzflush() ;
- ($out, $status) = $bz->bzclose() ;
-
- $dest = memBzip($source);
- alias compress
- $dest = memBunzip($source);
- alias decompress
-
- $bz = Compress::Bzip2->new( [PARAMS] );
-
- $bz = bzopen($filename or filehandle, $mode);
- alternate, with $bz created by new():
- $bz->bzopen($filename or filehandle, $mode);
-
- $bytesread = $bz->bzread($buffer [,$size]) ;
- $bytesread = $bz->bzreadline($line);
- $byteswritten = $bz->bzwrite($buffer [,$limit]);
- $errstring = $bz->bzerror();
- $status = $bz->bzeof();
- $status = $bz->bzflush();
- $status = $bz->bzclose() ;
-
- $status = $bz->bzsetparams( $param => $setting );
-
- $bz->total_in() ;
- $bz->total_out() ;
-
- $verstring = $bz->bzversion();
-
- $Compress::Bzip2::bzerrno
-
-=head1 DESCRIPTION
-
-The I<Compress::Bzip2> module provides a Perl interface to the I<Bzip2>
-compression library (see L</AUTHOR> for details about where to get
-I<Bzip2>). A relevant subset of the functionality provided by I<Bzip2>
-is available in I<Compress::Bzip2>.
-
-All string parameters can either be a scalar or a scalar reference.
-
-The module can be split into two general areas of functionality, namely
-in-memory compression/decompression and read/write access to I<bzip2>
-files. Each of these areas will be discussed separately below.
-
-=head1 FILE READ/WRITE INTERFACE
-
-A number of functions are supplied in I<bzlib> for reading and writing
-I<bzip2> files. Unfortunately, most of them are not suitable. So, this
-module provides another interface, built over top of the low level bzlib
-methods.
-
-=over 5
-
-=head2 B<$bz = bzopen(filename or filehandle, mode)>
-
-This function returns an object which is used to access the other
-I<bzip2> methods.
-
-The B<mode> parameter is used to specify both whether the file is
-opened for reading or writing, with "r" or "w" respectively.
-
-If a reference to an open filehandle is passed in place of the
-filename, it better be positioned to the start of a
-compression/decompression sequence.
-
-=head2 B<$bz = Compress::Bzip2-E<gt>new( [PARAMS] )>
-
-Create a Compress::Bzip2 object. Optionally, provide
-compression/decompression parameters as a keyword => setting list.
-See I<bzsetparams()> for a description of the parameters.
-
-=head2 B<$bz-E<gt>bzopen(filename or filehandle, mode)>
-
-This is bzopen, but it uses an object previously created by the new
-method. Other than that, it is identical to the above bzopen.
-
-=head2 B<$bytesread = $bz-E<gt>bzread($buffer [, $size]) ;>
-
-Reads B<$size> bytes from the compressed file into B<$buffer>. If
-B<$size> is not specified, it will default to 4096. If the scalar
-B<$buffer> is not large enough, it will be extended automatically.
-
-Returns the number of bytes actually read. On EOF it returns 0 and in
-the case of an error, -1.
-
-=head2 B<$bytesread = $bz-E<gt>bzreadline($line) ;>
-
-Reads the next line from the compressed file into B<$line>.
-
-Returns the number of bytes actually read. On EOF it returns 0 and in
-the case of an error, -1.
-
-It IS legal to intermix calls to B<bzread> and B<bzreadline>.
-
-At this time B<bzreadline> ignores the variable C<$/>
-(C<$INPUT_RECORD_SEPARATOR> or C<$RS> when C<English> is in use). The
-end of a line is denoted by the C character C<'\n'>.
-
-=head2 B<$byteswritten = $bz-E<gt>bzwrite($buffer [, $limit]) ;>
-
-Writes the contents of B<$buffer> to the compressed file. Returns the
-number of bytes actually written, or 0 on error.
-
-If $limit is given and non-zero, then only that many bytes from
-$buffer will be written.
-
-=head2 B<$status = $bz-E<gt>bzflush($flush) ;>
-
-Flushes all pending output to the compressed file.
-Works identically to the I<zlib> function it interfaces to. Note that
-the use of B<bzflush> can degrade compression.
-
-Returns C<BZ_OK> if B<$flush> is C<BZ_FINISH> and all output could be
-flushed. Otherwise the bzlib error code is returned.
-
-Refer to the I<bzlib> documentation for the valid values of B<$flush>.
-
-=head2 B<$status = $bz-E<gt>bzeof() ;>
-
-Returns 1 if the end of file has been detected while reading the input
-file, otherwise returns 0.
-
-=head2 B<$bz-E<gt>bzclose>
-
-Closes the compressed file. Any pending data is flushed to the file
-before it is closed.
-
-=head2 B<$bz-E<gt>bzsetparams( [PARAMS] );>
-
-Change settings for the deflate stream C<$bz>.
-
-The list of the valid options is shown below. Options not specified
-will remain unchanged.
-
-=over 5
-
-=item B<-verbosity>
-
-Defines the verbosity level. Valid values are 0 through 4,
-
-The default is C<-verbosity =E<gt> 0>.
-
-=item B<-blockSize100k>
-
-For bzip object opened for stream deflation or write.
-
-Defines the buffering factor of compression method. The algorithm
-buffers all data until the buffer is full, then it flushes all the
-data out. Use -blockSize100k to specify the size of the buffer.
-
-Valid settings are 1 through 9, representing a blocking in multiples
-of 100k.
-
-Note that each such block has an overhead of leading and trailing
-synchronization bytes. bzip2 recovery uses this information to
-pull useable data out of a corrupted file.
-
-A streaming application would probably want to set the blocking low.
-
-=item B<-workFactor>
-
-For bzip object opened for stream deflation or write.
-
-The workFactor setting tells the deflation algorithm how much work
-to invest to compensate for repetitive data.
-
-workFactor may be a number from 0 to 250 inclusive. The default setting
-is 30.
-
-See the bzip documentation for more information.
-
-=item B<-small>
-
-For bzip object opened for stream inflation or read.
-
-B<small> may be 0 or 1. Set C<small> to one to use a slower, less
-memory intensive algorithm.
-
-=back
-
-=head2 B<$bz-E<gt>bzerror>
-
-Returns the I<bzlib> error message or number for the last operation
-associated with B<$bz>. The return value will be the I<bzlib> error
-number when used in a numeric context and the I<bzlib> error message
-when used in a string context. The I<bzlib> error number constants,
-shown below, are available for use.
-
- BZ_CONFIG_ERROR
- BZ_DATA_ERROR
- BZ_DATA_ERROR_MAGIC
- BZ_FINISH
- BZ_FINISH_OK
- BZ_FLUSH
- BZ_FLUSH_OK
- BZ_IO_ERROR
- BZ_MAX_UNUSED
- BZ_MEM_ERROR
- BZ_OK
- BZ_OUTBUFF_FULL
- BZ_PARAM_ERROR
- BZ_RUN
- BZ_RUN_OK
- BZ_SEQUENCE_ERROR
- BZ_STREAM_END
- BZ_UNEXPECTED_EOF
-
-=head2 B<$bzerrno>
-
-The B<$bzerrno> scalar holds the error code associated with the most
-recent I<bzip2> routine. Note that unlike B<bzerror()>, the error is
-I<not> associated with a particular file.
-
-As with B<bzerror()> it returns an error number in numeric context and
-an error message in string context. Unlike B<bzerror()> though, the
-error message will correspond to the I<bzlib> message when the error is
-associated with I<bzlib> itself, or the UNIX error message when it is
-not (i.e. I<bzlib> returned C<Z_ERRORNO>).
-
-As there is an overlap between the error numbers used by I<bzlib> and
-UNIX, B<$bzerrno> should only be used to check for the presence of
-I<an> error in numeric context. Use B<bzerror()> to check for specific
-I<bzlib> errors. The I<bzcat> example below shows how the variable can
-be used safely.
-
-=back
-
-=head1 Compress::Bzip2 1.03 COMPATIBILITY
-
-While the 2.x thread forked off of 1.00, another line of development
-came to a head at 1.03. The 1.03 version worked with bzlib 1.0.2, had
-improvements to the error handling, single buffer inflate/deflate, a
-streaming interface to inflate/deflate, and a cpan style test suite.
-
-=over 5
-
-=head2 B<$dest = compress( $string, [$level] )>
-
-Alias to memBzip, this compresses string, using the optional
-compression level, 1 through 9, the default being 1. Returns a string
-containing the compressed data.
-
-On error I<undef> is returned.
-
-=head2 B<$dest = decompress($string)>
-
-Alias to memBunzip, this decompresses the data in string, returning a
-string containing the decompressed data.
-
-On error I<undef> is returned.
-
-=head2 B<$stream = compress_init( [PARAMS] )>
-
-Alias to bzdeflateInit. In addition to the named parameters
-documented for bzdeflateInit, the following are accepted:
-
- -level, alias to -blockSize100k
- -buffer, to set the buffer size.
-
-The -buffer option is ignored. The intermediate buffer size is not
-changeable.
-
-=head2 B<$stream = decompress_init( [PARAMS] )>
-
-Alias to bzinflateInit. See bzinflateInit for a description of the parameters.
-The option "-buffer" is accepted, but ignored.
-
-=head2 B<$output = $stream-E<gt>add( $string )>
-
-Add data to be compressed/decompressed. Returns whatever output is available
-(possibly none, if it's still buffering it), or undef on error.
-
-=head2 B<$output = $stream-E<gt>finish( [$string] )>
-
-Finish the operation; takes an optional final data string. Whatever is
-returned completes the output; returns undef on error.
-
-=head2 B<$stream-E<gt>error>
-
-Like the function, but applies to the current object only. Note that errors
-in a stream object are also returned by the function.
-
-=head2 B<$stream-E<gt>input_size>
-
-Alias to total_in. Total bytes passed to the stream.
-
-=head2 B<$stream-E<gt>output_size>
-
-Alias to total_out. Total bytes received from the stream.
-
-=back
-
-=head1 GZIP COMPATIBILITY INTERFACE
-
-Except for the exact state and error numbers, this package presents an
-interface very much like that given by the Compress::Zlib package.
-Mostly, if you take the method name, state or error number from
-Compress::Zlib and replace the "g" with a "b", your code should work.
-
-To make the interoperability even easier, all the Compress::Zlib method
-names have been used as aliases or cover functions for the bzip2 methods.
-
-Therefore, most code that uses Compress::Zlib should be able to use
-this package, with a one line change.
-
-Simply change
-
- $gz = Compress::Zlib::gzopen( "filename", "w" );
-
-to
-
- $gz = Compress::Bzip2::gzopen( "filename", "w" );
-
-Some of the Compress::Zlib aliases don't return anything useful, like
-crc32 or adler32, cause bzip2 doesn't do that sort of thing.
-
-=over 5
-
-=head2 B< $gz = gzopen( $filename, $mode ) >
-
-Alias for bzopen.
-
-=head2 B< $gz-E<gt>gzread( $buffer, [ $length ] ) >
-
-Alias for bzread.
-
-=head2 B< $gz-E<gt>gzreadline( $buffer ) >
-
-Alias for bzreadline.
-
-=head2 B< $gz-E<gt>gzwrite( $buffer ) >
-
-Alias for bzwrite.
-
-=head2 B< $gz-E<gt>gzflush( [$flushtype] ) >
-
-Alias for bzflush, with return code translation.
-
-=head2 B< $gz-E<gt>gzclose( ) >
-
-Alias for bzclose.
-
-=head2 B< $gz-E<gt>gzeof( ) >
-
-Alias for bzeof.
-
-=head2 B< $gz-E<gt>gzerror( ) >
-
-Alias for bzerror.
-
-=head2 B< $gz-E<gt>gzsetparams( $level, $strategy ) >
-
-This is a no-op.
-
-=head2 B< $d = deflateInit( [OPTS] ) >
-
-Alias for bzdeflateInit, with return code translation.
-
-All OPTS are ignored.
-
-=head2 B< $d-E<gt>deflate( $buffer ) >
-
-Alias for bzdeflate, with return code translation.
-
-=head2 B< $d-E<gt>deflateParams( [OPTS] ) >
-
-This is a no-op.
-
-=head2 B< $d-E<gt>flush( [$flushtype] ) >
-
-Cover function for bzflush or bzclose, depending on $flushtype.
-
-See the Compress::Zlib documentation for more information.
-
-=head2 B< $d-E<gt>dict_adler( ) >
-
-This is a no-op.
-
-=head2 B< $d-E<gt>msg( ) >
-
-This is a no-op.
-
-=head2 B< $d = inflateInit( [OPTS] ) >
-
-Alias for bzinflateInit, with return code translation.
-
-All OPTS are ignored.
-
-=head2 B< $d-E<gt>inflate( ) >
-
-Alias for bzinflate, with return code translation.
-
-=head2 B< $d-E<gt>inflateSync( ) >
-
-This is a no-op.
-
-=head2 B< $d-E<gt>adler32( $crc ) >
-
-This is a no-op.
-
-=head2 B< $d-E<gt>crc32( $crc ) >
-
-This is a no-op.
-
-=head2 B< $buffer = memGzip( $buffer ) >
-
-Alias for memBzip.
-
-=head2 B< $buffer = memGunzip( $buffer ) >
-
-Alias for memBunzip.
-
-=back
-
-=head1 IN-MEMORY COMPRESS/UNCOMPRESS
-
-Two high-level functions are provided by I<bzlib> to perform in-memory
-compression. They are B<memBzip> and B<memBunzip>. Two Perl subs are
-provided which provide similar functionality.
-
-=over 5
-
-=head2 B<$compressed = memBzip($buffer);>
-
-Compresses B<$source>. If successful it returns the compressed
-data. Otherwise it returns I<undef>.
-
-The buffer parameter can either be a scalar or a scalar reference.
-
-Essentially, an in-memory bzip file is created. It creates a minimal
-bzip header.
-
-=head2 B<$uncompressed = memBunzip($buffer);>
-
-Uncompresses B<$source>. If successful it returns the uncompressed
-data. Otherwise it returns I<undef>.
-
-The source buffer can either be a scalar or a scalar reference.
-
-The buffer parameter can either be a scalar or a scalar reference. The
-contents of the buffer parameter are destroyed after calling this
-function.
-
-=back
-
-=head1 STREAM DEFLATE
-
-The Perl interface will I<always> consume the complete input buffer
-before returning. Also the output buffer returned will be
-automatically grown to fit the amount of output available.
-
-Here is a definition of the interface available:
-
-=head2 B<($d, $status) = bzdeflateInit( [PARAMS] )>
-
-Initialises a deflation stream.
-
-If successful, it will return the initialised deflation stream, B<$d>
-and B<$status> of C<BZ_OK> in a list context. In scalar context it
-returns the deflation stream, B<$d>, only.
-
-If not successful, the returned deflation stream (B<$d>) will be
-I<undef> and B<$status> will hold the exact I<bzip2> error code.
-
-The function optionally takes a number of named options specified as
-C<-Name=E<gt>value> pairs. This allows individual options to be
-tailored without having to specify them all in the parameter list.
-
-Here is a list of the valid options:
-
-=over 5
-
-=item B<-verbosity>
-
-Defines the verbosity level. Valid values are 0 through 4,
-
-The default is C<-verbosity =E<gt> 0>.
-
-=item B<-blockSize100k>
-
-Defines the buffering factor of compression method. The algorithm
-buffers all data until the buffer is full, then it flushes all the
-data out. Use -blockSize100k to specify the size of the buffer.
-
-Valid settings are 1 through 9, representing a blocking in multiples
-of 100k.
-
-Note that each such block has an overhead of leading and trailing
-synchronization bytes. bzip2 recovery uses this information to
-pull useable data out of a corrupted file.
-
-A streaming application would probably want to set the blocking low.
-
-=item B<-workFactor>
-
-The workFactor setting tells the deflation algorithm how much work
-to invest to compensate for repetitive data.
-
-workFactor may be a number from 0 to 250 inclusive. The default setting
-is 30.
-
-See the bzip documentation for more information.
-
-=back
-
-Here is an example of using the B<deflateInit> optional parameter list
-to override the default buffer size and compression level. All other
-options will take their default values.
-
- bzdeflateInit( -blockSize100k => 1, -verbosity => 1 );
-
-=head2 B<($out, $status) = $d-E<gt>bzdeflate($buffer)>
-
-Deflates the contents of B<$buffer>. The buffer can either be a scalar
-or a scalar reference. When finished, B<$buffer> will be
-completely processed (assuming there were no errors). If the deflation
-was successful it returns deflated output, B<$out>, and a status
-value, B<$status>, of C<Z_OK>.
-
-On error, B<$out> will be I<undef> and B<$status> will contain the
-I<zlib> error code.
-
-In a scalar context B<bzdeflate> will return B<$out> only.
-
-As with the internal buffering of the I<deflate> function in I<bzip2>,
-it is not necessarily the case that any output will be produced by
-this method. So don't rely on the fact that B<$out> is empty for an
-error test. In fact, given the size of bzdeflates internal buffer,
-with most files it's likely you won't see any output at all until
-flush or close.
-
-=head2 B<($out, $status) = $d-E<gt>bzflush([flush_type])>
-
-Typically used to finish the deflation. Any pending output will be
-returned via B<$out>. B<$status> will have a value C<BZ_OK> if
-successful.
-
-In a scalar context B<bzflush> will return B<$out> only.
-
-Note that flushing can seriously degrade the compression ratio, so it
-should only be used to terminate a decompression (using C<BZ_FLUSH>) or
-when you want to create a I<full flush point> (using C<BZ_FINISH>).
-
-The allowable values for C<flush_type> are C<BZ_FLUSH> and C<BZ_FINISH>.
-
-For a handle opened for "w" (bzwrite), the default is C<BZ_FLUSH>.
-For a stream, the default for C<flush_type> is C<BZ_FINISH> (which is
-essentially a close and reopen).
-
-It is strongly recommended that you only set the C<flush_type>
-parameter if you fully understand the implications of what it
-does. See the C<bzip2> documentation for details.
-
-=head2 Example
-
-Here is a trivial example of using B<bzdeflate>. It simply reads standard
-input, deflates it and writes it to standard output.
-
- use strict ;
- use warnings ;
-
- use Compress::Bzip2 ;
-
- binmode STDIN;
- binmode STDOUT;
- my $x = bzdeflateInit()
- or die "Cannot create a deflation stream\n" ;
-
- my ($output, $status) ;
- while (<>)
- {
- ($output, $status) = $x->bzdeflate($_) ;
-
- $status == BZ_OK
- or die "deflation failed\n" ;
-
- print $output ;
- }
-
- ($output, $status) = $x->bzclose() ;
-
- $status == BZ_OK
- or die "deflation failed\n" ;
-
- print $output ;
-
-=head1 STREAM INFLATE
-
-Here is a definition of the interface:
-
-=head2 B<($i, $status) = inflateInit()>
-
-Initialises an inflation stream.
-
-In a list context it returns the inflation stream, B<$i>, and the
-I<zlib> status code (B<$status>). In a scalar context it returns the
-inflation stream only.
-
-If successful, B<$i> will hold the inflation stream and B<$status> will
-be C<BZ_OK>.
-
-If not successful, B<$i> will be I<undef> and B<$status> will hold the
-I<bzlib.h> error code.
-
-The function optionally takes a number of named options specified as
-C<-Name=E<gt>value> pairs. This allows individual options to be
-tailored without having to specify them all in the parameter list.
-
-For backward compatibility, it is also possible to pass the parameters
-as a reference to a hash containing the name=>value pairs.
-
-The function takes one optional parameter, a reference to a hash. The
-contents of the hash allow the deflation interface to be tailored.
-
-Here is a list of the valid options:
-
-=over 5
-
-=item B<-small>
-
-B<small> may be 0 or 1. Set C<small> to one to use a slower, less
-memory intensive algorithm.
-
-=item B<-verbosity>
-
-Defines the verbosity level. Valid values are 0 through 4,
-
-The default is C<-verbosity =E<gt> 0>.
-
-=back
-
-Here is an example of using the B<bzinflateInit> optional parameter.
-
- bzinflateInit( -small => 1, -verbosity => 1 );
-
-=head2 B<($out, $status) = $i-E<gt>bzinflate($buffer)>
-
-Inflates the complete contents of B<$buffer>. The buffer can either be
-a scalar or a scalar reference.
-
-Returns C<BZ_OK> if successful and C<BZ_STREAM_END> if the end of the
-compressed data has been successfully reached. If not successful,
-B<$out> will be I<undef> and B<$status> will hold the I<bzlib> error
-code.
-
-The C<$buffer> parameter is modified by C<bzinflate>. On completion it
-will contain what remains of the input buffer after inflation. This
-means that C<$buffer> will be an empty string when the return status
-is C<BZ_OK>. When the return status is C<BZ_STREAM_END> the C<$buffer>
-parameter will contains what (if anything) was stored in the input
-buffer after the deflated data stream.
-
-This feature is useful when processing a file format that encapsulates
-a compressed data stream.
-
-=head2 Example
-
-Here is an example of using B<bzinflate>.
-
- use strict ;
- use warnings ;
-
- use Compress::Bzip2;
-
- my $x = bzinflateInit()
- or die "Cannot create a inflation stream\n" ;
-
- my $input = '' ;
- binmode STDIN;
- binmode STDOUT;
-
- my ($output, $status) ;
- while (read(STDIN, $input, 4096))
- {
- ($output, $status) = $x->bzinflate(\$input) ;
-
- print $output
- if $status == BZ_OK or $status == BZ_STREAM_END ;
-
- last if $status != BZ_OK ;
- }
-
- die "inflation failed\n"
- unless $status == BZ_STREAM_END ;
-
-=head1 EXAMPLES
-
-Here are some example scripts of using the interface.
-
-=over 5
-
-=head2 B<A bzcat function>
-
- use strict ;
- use warnings ;
-
- use Compress::Bzip2 ;
-
- die "Usage: bzcat file...\n" unless @ARGV ;
-
- my $file ;
-
- foreach $file (@ARGV) {
- my $buffer ;
-
- my $bz = bzopen($file, "rb")
- or die "Cannot open $file: $bzerrno\n" ;
-
- print $buffer while $bz->bzread($buffer) > 0 ;
-
- die "Error reading from $file: $bzerrno" . ($bzerrno+0) . "\n"
- if $bzerrno != BZ_STREAM_END ;
-
- $bz->bzclose() ;
- }
-
-=head2 B<A grep using bzreadline>
-
- use strict ;
- use warnings ;
-
- use Compress::Bzip2 ;
-
- die "Usage: bzgrep pattern file...\n" unless @ARGV >= 2;
-
- my $pattern = shift ;
-
- my $file ;
-
- foreach $file (@ARGV) {
- my $bz = bzopen($file, "rb")
- or die "Cannot open $file: $bzerrno\n" ;
-
- while ($bz->bzreadline($_) > 0) {
- print if /$pattern/ ;
- }
-
- die "Error reading from $file: $bzerrno\n"
- if $bzerrno != Z_STREAM_END ;
-
- $bz->bzclose() ;
- }
-
-=head2 B<Streaming Compression>
-
-This script, I<bzstream>, does the opposite of the I<bzcat> script
-above. It reads from standard input and writes a bzip file to standard
-output.
-
- use strict ;
- use warnings ;
-
- use Compress::Bzip2 ;
-
- binmode STDOUT; # bzopen only sets it on the fd
-
- my $bz = bzopen(\*STDOUT, "wb")
- or die "Cannot open stdout: $bzerrno\n" ;
-
- while (<>) {
- $bz->bzwrite($_) or die "error writing: $bzerrno\n" ;
- }
-
- $bz->bzclose ;
-
-=back
-
-=head1 EXPORT
-
-Use the tags :all, :utilities, :constants, :bzip1 and :gzip.
-
-=head2 Export tag :all
-
-This exports all the exportable methods.
-
-=head2 Export tag :constants
-
-This exports only the BZ_* constants.
-
-=head2 Export tag :bzip1
-
-This exports the Compress::Bzip2 1.x functions, for compatibility.
-
- compress
- decompress
- compress_init
- decompress_init
- version
-
-These are actually aliases to memBzip and memBunzip.
-
-=head2 Export tag :utilities
-
-This gives an interface to the bzip2 methods.
-
- bzopen
- bzinflateInit
- bzdeflateInit
- memBzip
- memBunzip
- bzip2
- bunzip2
- bzcat
- bzlibversion
- $bzerrno
-
-=head2 Export tag :gzip
-
-This gives compatibility with Compress::Zlib.
-
- gzopen
- gzinflateInit
- gzdeflateInit
- memGzip
- memGunzip
- $gzerrno
-
-=head1 Exportable constants
-
-All the I<bzlib> constants are automatically imported when you make use
-of I<Compress::Bzip2>.
-
- BZ_CONFIG_ERROR
- BZ_DATA_ERROR
- BZ_DATA_ERROR_MAGIC
- BZ_FINISH
- BZ_FINISH_OK
- BZ_FLUSH
- BZ_FLUSH_OK
- BZ_IO_ERROR
- BZ_MAX_UNUSED
- BZ_MEM_ERROR
- BZ_OK
- BZ_OUTBUFF_FULL
- BZ_PARAM_ERROR
- BZ_RUN
- BZ_RUN_OK
- BZ_SEQUENCE_ERROR
- BZ_STREAM_END
- BZ_UNEXPECTED_EOF
-
-=head1 SEE ALSO
-
-The documentation for zlib, bzip2 and Compress::Zlib.
-
-=head1 AUTHOR
-
-Rob Janes, E<lt>arjay at cpan.orgE<gt>
-
-=head1 COPYRIGHT AND LICENSE
-
-Copyright (C) 2005 by Rob Janes
-
-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.3 or,
-at your option, any later version of Perl 5 you may have available.
-
-=head1 AUTHOR
-
-The I<Compress::Bzip2> module was originally written by Gawdi Azem
-F<azemgi@rupert.informatik.uni-stuttgart.de>.
-
-The first I<Compress::Bzip2> module was written by Gawdi Azem
-F<azemgi@rupert.informatik.uni-stuttgart.de>. It provided an
-interface to the in memory inflate and deflate routines.
-
-I<Compress::Bzip2> was subsequently passed on to Marco Carnut
-F<kiko@tempest.com.br> who shepharded it through to version 1.03, a
-set of changes which included upgrades to handle bzlib 1.0.2, and
-improvements to the in memory inflate and deflate routines. The
-streaming interface and error information were added by David Robins
-F<dbrobins@davidrobins.net>.
-
-Version 2 of I<Compress::Bzip2> is due to Rob Janes, of
-arjay@cpan.org. This release is intended to give an interface
-close to that of Compress::Zlib. It's development forks from 1.00,
-not 1.03, so the streaming interface is not the same as that in 1.03,
-although apparently compatible as it passes the 1.03 test suite.
-
-=head1 MODIFICATION HISTORY
-
-See the Changes file.
-
-2.00 Second public release of I<Compress::Bzip2>.
-
-
-
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Compress/Raw/Bzip2.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Compress/Raw/Bzip2.pm
deleted file mode 100644
index 041a3eec989..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Compress/Raw/Bzip2.pm
+++ /dev/null
@@ -1,329 +0,0 @@
-
-package Compress::Raw::Bzip2;
-
-use strict ;
-use warnings ;
-
-require 5.004 ;
-require Exporter;
-use AutoLoader;
-use Carp ;
-
-use bytes ;
-our ($VERSION, $XS_VERSION, @ISA, @EXPORT, $AUTOLOAD);
-
-$VERSION = '2.011';
-$XS_VERSION = $VERSION;
-$VERSION = eval $VERSION;
-
-@ISA = qw(Exporter);
-# 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(
- BZ_RUN
- BZ_FLUSH
- BZ_FINISH
-
- BZ_OK
- BZ_RUN_OK
- BZ_FLUSH_OK
- BZ_FINISH_OK
- BZ_STREAM_END
- BZ_SEQUENCE_ERROR
- BZ_PARAM_ERROR
- BZ_MEM_ERROR
- BZ_DATA_ERROR
- BZ_DATA_ERROR_MAGIC
- BZ_IO_ERROR
- BZ_UNEXPECTED_EOF
- BZ_OUTBUFF_FULL
- BZ_CONFIG_ERROR
-
- );
-
-sub AUTOLOAD {
- my($constname);
- ($constname = $AUTOLOAD) =~ s/.*:://;
- my ($error, $val) = constant($constname);
- Carp::croak $error if $error;
- no strict 'refs';
- *{$AUTOLOAD} = sub { $val };
- goto &{$AUTOLOAD};
-
-}
-
-use constant FLAG_APPEND => 1 ;
-use constant FLAG_CRC => 2 ;
-use constant FLAG_ADLER => 4 ;
-use constant FLAG_CONSUME_INPUT => 8 ;
-
-eval {
- require XSLoader;
- XSLoader::load('Compress::Raw::Bzip2', $XS_VERSION);
- 1;
-}
-or do {
- require DynaLoader;
- local @ISA = qw(DynaLoader);
- bootstrap Compress::Raw::Bzip2 $XS_VERSION ;
-};
-
-#sub Compress::Raw::Bzip2::new
-#{
-# my $class = shift ;
-# my ($ptr, $status) = _new(@_);
-# return wantarray ? (undef, $status) : undef
-# unless $ptr ;
-# my $obj = bless [$ptr], $class ;
-# return wantarray ? ($obj, $status) : $obj;
-#}
-#
-#package Compress::Raw::Bunzip2 ;
-#
-#sub Compress::Raw::Bunzip2::new
-#{
-# my $class = shift ;
-# my ($ptr, $status) = _new(@_);
-# return wantarray ? (undef, $status) : undef
-# unless $ptr ;
-# my $obj = bless [$ptr], $class ;
-# return wantarray ? ($obj, $status) : $obj;
-#}
-
-package Compress::Raw::Bzip2;
-
-1;
-
-__END__
-
-
-=head1 NAME
-
-Compress::Raw::Bzip2 - Low-Level Interface to bzip2 compression library
-
-=head1 SYNOPSIS
-
- use Compress::Raw::Bzip2 ;
-
- my ($bz, $status) = new Compress::Raw::Bzip2 [OPTS]
- or die "Cannot create bzip2 object: $bzerno\n";
-
- $status = $bz->bzdeflate($input, $output);
- $status = $bz->bzflush($output);
- $status = $bz->bzclose($output);
-
- my ($bz, $status) = new Compress::Raw::Bunzip2 [OPTS]
- or die "Cannot create bunzip2 object: $bzerno\n";
-
- $status = $bz->bzinflate($input, $output);
-
- my $version = Compress::Raw::Bzip2::bzlibversion();
-
-=head1 DESCRIPTION
-
-C<Compress::Raw::Bzip2> provides an interface to the in-memory
-compression/uncompression functions from the bzip2 compression library.
-
-Although the primary purpose for the existence of C<Compress::Raw::Bzip2>
-is for use by the C<IO::Compress::Bzip2> and C<IO::Compress::Bunzip2>
-modules, it can be used on its own for simple compression/uncompression
-tasks.
-
-=head1 Compression
-
-=head2 ($z, $status) = new Compress::Raw::Bzip2 $appendOutput, $blockSize100k, $workfactor;
-
-Creates a new compression object.
-
-If successful, it will return the initialised compression object, C<$z>
-and a C<$status> of C<BZ_OK> in a list context. In scalar context it
-returns the deflation object, C<$z>, only.
-
-If not successful, the returned compression object, C<$z>, will be
-I<undef> and C<$status> will hold the a I<bzip2> error code.
-
-Below is a list of the valid options:
-
-=over 5
-
-=item B<$appendOutput>
-
-Controls whether the compressed data is appended to the output buffer in
-the C<bzdeflate>, C<bzflush> and C<bzclose> methods.
-
-Defaults to 1.
-
-=item B<$blockSize100k>
-
-To quote the bzip2 documentation
-
- blockSize100k specifies the block size to be used for compression. It
- should be a value between 1 and 9 inclusive, and the actual block size
- used is 100000 x this figure. 9 gives the best compression but takes
- most memory.
-
-Defaults to 1.
-
-=item B<$workfactor>
-
-To quote the bzip2 documentation
-
- This parameter controls how the compression phase behaves when
- presented with worst case, highly repetitive, input data. If
- compression runs into difficulties caused by repetitive data, the
- library switches from the standard sorting algorithm to a fallback
- algorithm. The fallback is slower than the standard algorithm by
- perhaps a factor of three, but always behaves reasonably, no matter how
- bad the input.
-
- Lower values of workFactor reduce the amount of effort the standard
- algorithm will expend before resorting to the fallback. You should set
- this parameter carefully; too low, and many inputs will be handled by
- the fallback algorithm and so compress rather slowly, too high, and
- your average-to-worst case compression times can become very large. The
- default value of 30 gives reasonable behaviour over a wide range of
- circumstances.
-
- Allowable values range from 0 to 250 inclusive. 0 is a special case,
- equivalent to using the default value of 30.
-
-Defaults to 0.
-
-=back
-
-=head2 $status = $bz->bzdeflate($input, $output);
-
-Reads the contents of C<$input>, compresses it and writes the compressed
-data to C<$output>.
-
-Returns C<BZ_RUN_OK> on success and a C<bzip2> error code on failure.
-
-If C<appendOutput> is enabled in the constructor for the bzip2 object, the
-compressed data will be appended to C<$output>. If not enabled, C<$output>
-will be truncated before the compressed data is written to it.
-
-=head2 $status = $bz->bzflush($output);
-
-Flushes any pending compressed data to C<$output>.
-
-Returns C<BZ_RUN_OK> on success and a C<bzip2> error code on failure.
-
-=head2 $status = $bz->bzclose($output);
-
-Terminates the compressed data stream and flushes any pending compressed
-data to C<$output>.
-
-Returns C<BZ_STREAM_END> on success and a C<bzip2> error code on failure.
-
-=head2 Example
-
-=head1 Uncompression
-
-=head2 ($z, $status) = new Compress::Raw::Bunzip2 $appendOutput, $consumeInput, $small;
-
-If successful, it will return the initialised uncompression object, C<$z>
-and a C<$status> of C<BZ_OK> in a list context. In scalar context it
-returns the deflation object, C<$z>, only.
-
-If not successful, the returned uncompression object, C<$z>, will be
-I<undef> and C<$status> will hold the a I<bzip2> error code.
-
-Below is a list of the valid options:
-
-=over 5
-
-=item B<$appendOutput>
-
-Controls whether the compressed data is appended to the output buffer in the
-C<bzinflate>, C<bzflush> and C<bzclose> methods.
-
-Defaults to 1.
-
-=item B<$consumeInput>
-
-=item B<$small>
-
-To quote the bzip2 documentation
-
- If small is nonzero, the library will use an alternative decompression
- algorithm which uses less memory but at the cost of decompressing more
- slowly (roughly speaking, half the speed, but the maximum memory
- requirement drops to around 2300k).
-
-Defaults to 0.
-
-=back
-
-=head2 $status = $z->bzinflate($input, $output);
-
-Uncompresses C<$input> and writes the uncompressed data to C<$output>.
-
-Returns C<BZ_OK> if the uncompression was successful, but the end of the
-compressed data stream has not been reached. Returns C<BZ_STREAM_END> on
-successful uncompression and the end of the compression stream has been
-reached.
-
-If C<consumeInput> is enabled in the constructor for the bunzip2 object,
-C<$input> will have all compressed data removed from it after
-uncompression. On C<BZ_OK> return this will mean that C<$input> will be an
-empty string; when C<BZ_STREAM_END> C<$input> will either be an empty
-string or will contain whatever data immediately followed the compressed
-data stream.
-
-If C<appendOutput> is enabled in the constructor for the bunzip2 object,
-the uncompressed data will be appended to C<$output>. If not enabled,
-C<$output> will be truncated before the uncompressed data is written to it.
-
-=head1 Constants
-
-The following bzip2 constants are exported by this module
-
- BZ_RUN
- BZ_FLUSH
- BZ_FINISH
-
- BZ_OK
- BZ_RUN_OK
- BZ_FLUSH_OK
- BZ_FINISH_OK
- BZ_STREAM_END
- BZ_SEQUENCE_ERROR
- BZ_PARAM_ERROR
- BZ_MEM_ERROR
- BZ_DATA_ERROR
- BZ_DATA_ERROR_MAGIC
- BZ_IO_ERROR
- BZ_UNEXPECTED_EOF
- BZ_OUTBUFF_FULL
- BZ_CONFIG_ERROR
-
-=head1 SEE ALSO
-
-L<Compress::Zlib>, L<IO::Compress::Gzip>, L<IO::Uncompress::Gunzip>, L<IO::Compress::Deflate>, L<IO::Uncompress::Inflate>, L<IO::Compress::RawDeflate>, L<IO::Uncompress::RawInflate>, L<IO::Compress::Bzip2>, L<IO::Uncompress::Bunzip2>, L<IO::Compress::Lzop>, L<IO::Uncompress::UnLzop>, L<IO::Compress::Lzf>, L<IO::Uncompress::UnLzf>, L<IO::Uncompress::AnyInflate>, L<IO::Uncompress::AnyUncompress>
-
-L<Compress::Zlib::FAQ|Compress::Zlib::FAQ>
-
-L<File::GlobMapper|File::GlobMapper>, L<Archive::Zip|Archive::Zip>,
-L<Archive::Tar|Archive::Tar>,
-L<IO::Zlib|IO::Zlib>
-
-The primary site for the bzip2 program is F<http://www.bzip.org>.
-
-See the module L<Compress::Bzip2|Compress::Bzip2>
-
-=head1 AUTHOR
-
-This module was written by Paul Marquess, F<pmqs@cpan.org>.
-
-=head1 MODIFICATION HISTORY
-
-See the Changes file.
-
-=head1 COPYRIGHT AND LICENSE
-
-Copyright (c) 2005-2008 Paul Marquess. All rights reserved.
-
-This program is free software; you can redistribute it and/or
-modify it under the same terms as Perl itself.
-
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Cwd.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Cwd.pm
deleted file mode 100644
index b93c0036120..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Cwd.pm
+++ /dev/null
@@ -1,763 +0,0 @@
-package Cwd;
-
-=head1 NAME
-
-Cwd - get pathname of current working directory
-
-=head1 SYNOPSIS
-
- use Cwd;
- my $dir = getcwd;
-
- use Cwd 'abs_path';
- my $abs_path = abs_path($file);
-
-=head1 DESCRIPTION
-
-This module provides functions for determining the pathname of the
-current working directory. It is recommended that getcwd (or another
-*cwd() function) be used in I<all> code to ensure portability.
-
-By default, it exports the functions cwd(), getcwd(), fastcwd(), and
-fastgetcwd() (and, on Win32, getdcwd()) into the caller's namespace.
-
-
-=head2 getcwd and friends
-
-Each of these functions are called without arguments and return the
-absolute path of the current working directory.
-
-=over 4
-
-=item getcwd
-
- my $cwd = getcwd();
-
-Returns the current working directory.
-
-Exposes the POSIX function getcwd(3) or re-implements it if it's not
-available.
-
-=item cwd
-
- my $cwd = cwd();
-
-The cwd() is the most natural form for the current architecture. For
-most systems it is identical to `pwd` (but without the trailing line
-terminator).
-
-=item fastcwd
-
- my $cwd = fastcwd();
-
-A more dangerous version of getcwd(), but potentially faster.
-
-It might conceivably chdir() you out of a directory that it can't
-chdir() you back into. If fastcwd encounters a problem it will return
-undef but will probably leave you in a different directory. For a
-measure of extra security, if everything appears to have worked, the
-fastcwd() function will check that it leaves you in the same directory
-that it started in. If it has changed it will C<die> with the message
-"Unstable directory path, current directory changed
-unexpectedly". That should never happen.
-
-=item fastgetcwd
-
- my $cwd = fastgetcwd();
-
-The fastgetcwd() function is provided as a synonym for cwd().
-
-=item getdcwd
-
- my $cwd = getdcwd();
- my $cwd = getdcwd('C:');
-
-The getdcwd() function is also provided on Win32 to get the current working
-directory on the specified drive, since Windows maintains a separate current
-working directory for each drive. If no drive is specified then the current
-drive is assumed.
-
-This function simply calls the Microsoft C library _getdcwd() function.
-
-=back
-
-
-=head2 abs_path and friends
-
-These functions are exported only on request. They each take a single
-argument and return the absolute pathname for it. If no argument is
-given they'll use the current working directory.
-
-=over 4
-
-=item abs_path
-
- my $abs_path = abs_path($file);
-
-Uses the same algorithm as getcwd(). Symbolic links and relative-path
-components ("." and "..") are resolved to return the canonical
-pathname, just like realpath(3).
-
-=item realpath
-
- my $abs_path = realpath($file);
-
-A synonym for abs_path().
-
-=item fast_abs_path
-
- my $abs_path = fast_abs_path($file);
-
-A more dangerous, but potentially faster version of abs_path.
-
-=back
-
-=head2 $ENV{PWD}
-
-If you ask to override your chdir() built-in function,
-
- use Cwd qw(chdir);
-
-then your PWD environment variable will be kept up to date. Note that
-it will only be kept up to date if all packages which use chdir import
-it from Cwd.
-
-
-=head1 NOTES
-
-=over 4
-
-=item *
-
-Since the path seperators are different on some operating systems ('/'
-on Unix, ':' on MacPerl, etc...) we recommend you use the File::Spec
-modules wherever portability is a concern.
-
-=item *
-
-Actually, on Mac OS, the C<getcwd()>, C<fastgetcwd()> and C<fastcwd()>
-functions are all aliases for the C<cwd()> function, which, on Mac OS,
-calls `pwd`. Likewise, the C<abs_path()> function is an alias for
-C<fast_abs_path()>.
-
-=back
-
-=head1 AUTHOR
-
-Originally by the perl5-porters.
-
-Maintained by Ken Williams <KWILLIAMS@cpan.org>
-
-=head1 COPYRIGHT
-
-Copyright (c) 2004 by the Perl 5 Porters. All rights reserved.
-
-This program is free software; you can redistribute it and/or modify
-it under the same terms as Perl itself.
-
-Portions of the C code in this library are copyright (c) 1994 by the
-Regents of the University of California. All rights reserved. The
-license on this code is compatible with the licensing of the rest of
-the distribution - please see the source code in F<Cwd.xs> for the
-details.
-
-=head1 SEE ALSO
-
-L<File::chdir>
-
-=cut
-
-use strict;
-use Exporter;
-use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION);
-
-$VERSION = '3.2701';
-
-@ISA = qw/ Exporter /;
-@EXPORT = qw(cwd getcwd fastcwd fastgetcwd);
-push @EXPORT, qw(getdcwd) if $^O eq 'MSWin32';
-@EXPORT_OK = qw(chdir abs_path fast_abs_path realpath fast_realpath);
-
-# sys_cwd may keep the builtin command
-
-# All the functionality of this module may provided by builtins,
-# there is no sense to process the rest of the file.
-# The best choice may be to have this in BEGIN, but how to return from BEGIN?
-
-if ($^O eq 'os2') {
- local $^W = 0;
-
- *cwd = defined &sys_cwd ? \&sys_cwd : \&_os2_cwd;
- *getcwd = \&cwd;
- *fastgetcwd = \&cwd;
- *fastcwd = \&cwd;
-
- *fast_abs_path = \&sys_abspath if defined &sys_abspath;
- *abs_path = \&fast_abs_path;
- *realpath = \&fast_abs_path;
- *fast_realpath = \&fast_abs_path;
-
- return 1;
-}
-
-# If loading the XS stuff doesn't work, we can fall back to pure perl
-eval {
- if ( $] >= 5.006 ) {
- require XSLoader;
- XSLoader::load( __PACKAGE__, $VERSION );
- } else {
- require DynaLoader;
- push @ISA, 'DynaLoader';
- __PACKAGE__->bootstrap( $VERSION );
- }
-};
-
-# Must be after the DynaLoader stuff:
-$VERSION = eval $VERSION;
-
-# Big nasty table of function aliases
-my %METHOD_MAP =
- (
- VMS =>
- {
- cwd => '_vms_cwd',
- getcwd => '_vms_cwd',
- fastcwd => '_vms_cwd',
- fastgetcwd => '_vms_cwd',
- abs_path => '_vms_abs_path',
- fast_abs_path => '_vms_abs_path',
- },
-
- MSWin32 =>
- {
- # We assume that &_NT_cwd is defined as an XSUB or in the core.
- cwd => '_NT_cwd',
- getcwd => '_NT_cwd',
- fastcwd => '_NT_cwd',
- fastgetcwd => '_NT_cwd',
- abs_path => 'fast_abs_path',
- realpath => 'fast_abs_path',
- },
-
- dos =>
- {
- cwd => '_dos_cwd',
- getcwd => '_dos_cwd',
- fastgetcwd => '_dos_cwd',
- fastcwd => '_dos_cwd',
- abs_path => 'fast_abs_path',
- },
-
- qnx =>
- {
- cwd => '_qnx_cwd',
- getcwd => '_qnx_cwd',
- fastgetcwd => '_qnx_cwd',
- fastcwd => '_qnx_cwd',
- abs_path => '_qnx_abs_path',
- fast_abs_path => '_qnx_abs_path',
- },
-
- cygwin =>
- {
- getcwd => 'cwd',
- fastgetcwd => 'cwd',
- fastcwd => 'cwd',
- abs_path => 'fast_abs_path',
- realpath => 'fast_abs_path',
- },
-
- epoc =>
- {
- cwd => '_epoc_cwd',
- getcwd => '_epoc_cwd',
- fastgetcwd => '_epoc_cwd',
- fastcwd => '_epoc_cwd',
- abs_path => 'fast_abs_path',
- },
-
- MacOS =>
- {
- getcwd => 'cwd',
- fastgetcwd => 'cwd',
- fastcwd => 'cwd',
- abs_path => 'fast_abs_path',
- },
- );
-
-$METHOD_MAP{NT} = $METHOD_MAP{MSWin32};
-$METHOD_MAP{nto} = $METHOD_MAP{qnx};
-
-
-# Find the pwd command in the expected locations. We assume these
-# are safe. This prevents _backtick_pwd() consulting $ENV{PATH}
-# so everything works under taint mode.
-my $pwd_cmd;
-foreach my $try ('/bin/pwd',
- '/usr/bin/pwd',
- '/QOpenSys/bin/pwd', # OS/400 PASE.
- ) {
-
- if( -x $try ) {
- $pwd_cmd = $try;
- last;
- }
-}
-my $found_pwd_cmd = defined($pwd_cmd);
-unless ($pwd_cmd) {
- # Isn't this wrong? _backtick_pwd() will fail if somenone has
- # pwd in their path but it is not /bin/pwd or /usr/bin/pwd?
- # See [perl #16774]. --jhi
- $pwd_cmd = 'pwd';
-}
-
-# Lazy-load Carp
-sub _carp { require Carp; Carp::carp(@_) }
-sub _croak { require Carp; Carp::croak(@_) }
-
-# The 'natural and safe form' for UNIX (pwd may be setuid root)
-sub _backtick_pwd {
- # Localize %ENV entries in a way that won't create new hash keys
- my @localize = grep exists $ENV{$_}, qw(PATH IFS CDPATH ENV BASH_ENV);
- local @ENV{@localize};
-
- my $cwd = `$pwd_cmd`;
- # Belt-and-suspenders in case someone said "undef $/".
- local $/ = "\n";
- # `pwd` may fail e.g. if the disk is full
- chomp($cwd) if defined $cwd;
- $cwd;
-}
-
-# Since some ports may predefine cwd internally (e.g., NT)
-# we take care not to override an existing definition for cwd().
-
-unless ($METHOD_MAP{$^O}{cwd} or defined &cwd) {
- # The pwd command is not available in some chroot(2)'ed environments
- my $sep = $Config::Config{path_sep} || ':';
- my $os = $^O; # Protect $^O from tainting
-
-
- # Try again to find a pwd, this time searching the whole PATH.
- if (defined $ENV{PATH} and $os ne 'MSWin32') { # no pwd on Windows
- my @candidates = split($sep, $ENV{PATH});
- while (!$found_pwd_cmd and @candidates) {
- my $candidate = shift @candidates;
- $found_pwd_cmd = 1 if -x "$candidate/pwd";
- }
- }
-
- # MacOS has some special magic to make `pwd` work.
- if( $os eq 'MacOS' || $found_pwd_cmd )
- {
- *cwd = \&_backtick_pwd;
- }
- else {
- *cwd = \&getcwd;
- }
-}
-
-if ($^O eq 'cygwin') {
- # We need to make sure cwd() is called with no args, because it's
- # got an arg-less prototype and will die if args are present.
- local $^W = 0;
- my $orig_cwd = \&cwd;
- *cwd = sub { &$orig_cwd() }
-}
-
-
-# set a reasonable (and very safe) default for fastgetcwd, in case it
-# isn't redefined later (20001212 rspier)
-*fastgetcwd = \&cwd;
-
-# A non-XS version of getcwd() - also used to bootstrap the perl build
-# process, when miniperl is running and no XS loading happens.
-sub _perl_getcwd
-{
- abs_path('.');
-}
-
-# By John Bazik
-#
-# Usage: $cwd = &fastcwd;
-#
-# This is a faster version of getcwd. It's also more dangerous because
-# you might chdir out of a directory that you can't chdir back into.
-
-sub fastcwd_ {
- my($odev, $oino, $cdev, $cino, $tdev, $tino);
- my(@path, $path);
- local(*DIR);
-
- my($orig_cdev, $orig_cino) = stat('.');
- ($cdev, $cino) = ($orig_cdev, $orig_cino);
- for (;;) {
- my $direntry;
- ($odev, $oino) = ($cdev, $cino);
- CORE::chdir('..') || return undef;
- ($cdev, $cino) = stat('.');
- last if $odev == $cdev && $oino == $cino;
- opendir(DIR, '.') || return undef;
- for (;;) {
- $direntry = readdir(DIR);
- last unless defined $direntry;
- next if $direntry eq '.';
- next if $direntry eq '..';
-
- ($tdev, $tino) = lstat($direntry);
- last unless $tdev != $odev || $tino != $oino;
- }
- closedir(DIR);
- return undef unless defined $direntry; # should never happen
- unshift(@path, $direntry);
- }
- $path = '/' . join('/', @path);
- if ($^O eq 'apollo') { $path = "/".$path; }
- # At this point $path may be tainted (if tainting) and chdir would fail.
- # Untaint it then check that we landed where we started.
- $path =~ /^(.*)\z/s # untaint
- && CORE::chdir($1) or return undef;
- ($cdev, $cino) = stat('.');
- die "Unstable directory path, current directory changed unexpectedly"
- if $cdev != $orig_cdev || $cino != $orig_cino;
- $path;
-}
-if (not defined &fastcwd) { *fastcwd = \&fastcwd_ }
-
-
-# Keeps track of current working directory in PWD environment var
-# Usage:
-# use Cwd 'chdir';
-# chdir $newdir;
-
-my $chdir_init = 0;
-
-sub chdir_init {
- if ($ENV{'PWD'} and $^O ne 'os2' and $^O ne 'dos' and $^O ne 'MSWin32') {
- my($dd,$di) = stat('.');
- my($pd,$pi) = stat($ENV{'PWD'});
- if (!defined $dd or !defined $pd or $di != $pi or $dd != $pd) {
- $ENV{'PWD'} = cwd();
- }
- }
- else {
- my $wd = cwd();
- $wd = Win32::GetFullPathName($wd) if $^O eq 'MSWin32';
- $ENV{'PWD'} = $wd;
- }
- # Strip an automounter prefix (where /tmp_mnt/foo/bar == /foo/bar)
- if ($^O ne 'MSWin32' and $ENV{'PWD'} =~ m|(/[^/]+(/[^/]+/[^/]+))(.*)|s) {
- my($pd,$pi) = stat($2);
- my($dd,$di) = stat($1);
- if (defined $pd and defined $dd and $di == $pi and $dd == $pd) {
- $ENV{'PWD'}="$2$3";
- }
- }
- $chdir_init = 1;
-}
-
-sub chdir {
- my $newdir = @_ ? shift : ''; # allow for no arg (chdir to HOME dir)
- $newdir =~ s|///*|/|g unless $^O eq 'MSWin32';
- chdir_init() unless $chdir_init;
- my $newpwd;
- if ($^O eq 'MSWin32') {
- # get the full path name *before* the chdir()
- $newpwd = Win32::GetFullPathName($newdir);
- }
-
- return 0 unless CORE::chdir $newdir;
-
- if ($^O eq 'VMS') {
- return $ENV{'PWD'} = $ENV{'DEFAULT'}
- }
- elsif ($^O eq 'MacOS') {
- return $ENV{'PWD'} = cwd();
- }
- elsif ($^O eq 'MSWin32') {
- $ENV{'PWD'} = $newpwd;
- return 1;
- }
-
- if (ref $newdir eq 'GLOB') { # in case a file/dir handle is passed in
- $ENV{'PWD'} = cwd();
- } elsif ($newdir =~ m#^/#s) {
- $ENV{'PWD'} = $newdir;
- } else {
- my @curdir = split(m#/#,$ENV{'PWD'});
- @curdir = ('') unless @curdir;
- my $component;
- foreach $component (split(m#/#, $newdir)) {
- next if $component eq '.';
- pop(@curdir),next if $component eq '..';
- push(@curdir,$component);
- }
- $ENV{'PWD'} = join('/',@curdir) || '/';
- }
- 1;
-}
-
-
-sub _perl_abs_path
-{
- my $start = @_ ? shift : '.';
- my($dotdots, $cwd, @pst, @cst, $dir, @tst);
-
- unless (@cst = stat( $start ))
- {
- _carp("stat($start): $!");
- return '';
- }
-
- unless (-d _) {
- # Make sure we can be invoked on plain files, not just directories.
- # NOTE that this routine assumes that '/' is the only directory separator.
-
- my ($dir, $file) = $start =~ m{^(.*)/(.+)$}
- or return cwd() . '/' . $start;
-
- # Can't use "-l _" here, because the previous stat was a stat(), not an lstat().
- if (-l $start) {
- my $link_target = readlink($start);
- die "Can't resolve link $start: $!" unless defined $link_target;
-
- require File::Spec;
- $link_target = $dir . '/' . $link_target
- unless File::Spec->file_name_is_absolute($link_target);
-
- return abs_path($link_target);
- }
-
- return $dir ? abs_path($dir) . "/$file" : "/$file";
- }
-
- $cwd = '';
- $dotdots = $start;
- do
- {
- $dotdots .= '/..';
- @pst = @cst;
- local *PARENT;
- unless (opendir(PARENT, $dotdots))
- {
- # probably a permissions issue. Try the native command.
- return File::Spec->rel2abs( $start, _backtick_pwd() );
- }
- unless (@cst = stat($dotdots))
- {
- _carp("stat($dotdots): $!");
- closedir(PARENT);
- return '';
- }
- if ($pst[0] == $cst[0] && $pst[1] == $cst[1])
- {
- $dir = undef;
- }
- else
- {
- do
- {
- unless (defined ($dir = readdir(PARENT)))
- {
- _carp("readdir($dotdots): $!");
- closedir(PARENT);
- return '';
- }
- $tst[0] = $pst[0]+1 unless (@tst = lstat("$dotdots/$dir"))
- }
- while ($dir eq '.' || $dir eq '..' || $tst[0] != $pst[0] ||
- $tst[1] != $pst[1]);
- }
- $cwd = (defined $dir ? "$dir" : "" ) . "/$cwd" ;
- closedir(PARENT);
- } while (defined $dir);
- chop($cwd) unless $cwd eq '/'; # drop the trailing /
- $cwd;
-}
-
-
-my $Curdir;
-sub fast_abs_path {
- local $ENV{PWD} = $ENV{PWD} || ''; # Guard against clobberage
- my $cwd = getcwd();
- require File::Spec;
- my $path = @_ ? shift : ($Curdir ||= File::Spec->curdir);
-
- # Detaint else we'll explode in taint mode. This is safe because
- # we're not doing anything dangerous with it.
- ($path) = $path =~ /(.*)/;
- ($cwd) = $cwd =~ /(.*)/;
-
- unless (-e $path) {
- _croak("$path: No such file or directory");
- }
-
- unless (-d _) {
- # Make sure we can be invoked on plain files, not just directories.
-
- my ($vol, $dir, $file) = File::Spec->splitpath($path);
- return File::Spec->catfile($cwd, $path) unless length $dir;
-
- if (-l $path) {
- my $link_target = readlink($path);
- die "Can't resolve link $path: $!" unless defined $link_target;
-
- $link_target = File::Spec->catpath($vol, $dir, $link_target)
- unless File::Spec->file_name_is_absolute($link_target);
-
- return fast_abs_path($link_target);
- }
-
- return $dir eq File::Spec->rootdir
- ? File::Spec->catpath($vol, $dir, $file)
- : fast_abs_path(File::Spec->catpath($vol, $dir, '')) . '/' . $file;
- }
-
- if (!CORE::chdir($path)) {
- _croak("Cannot chdir to $path: $!");
- }
- my $realpath = getcwd();
- if (! ((-d $cwd) && (CORE::chdir($cwd)))) {
- _croak("Cannot chdir back to $cwd: $!");
- }
- $realpath;
-}
-
-# added function alias to follow principle of least surprise
-# based on previous aliasing. --tchrist 27-Jan-00
-*fast_realpath = \&fast_abs_path;
-
-
-# --- PORTING SECTION ---
-
-# VMS: $ENV{'DEFAULT'} points to default directory at all times
-# 06-Mar-1996 Charles Bailey bailey@newman.upenn.edu
-# Note: Use of Cwd::chdir() causes the logical name PWD to be defined
-# in the process logical name table as the default device and directory
-# seen by Perl. This may not be the same as the default device
-# and directory seen by DCL after Perl exits, since the effects
-# the CRTL chdir() function persist only until Perl exits.
-
-sub _vms_cwd {
- return $ENV{'DEFAULT'};
-}
-
-sub _vms_abs_path {
- return $ENV{'DEFAULT'} unless @_;
- my $path = shift;
-
- if (-l $path) {
- my $link_target = readlink($path);
- die "Can't resolve link $path: $!" unless defined $link_target;
-
- return _vms_abs_path($link_target);
- }
-
- if (defined &VMS::Filespec::vms_realpath) {
- my $path = $_[0];
- if ($path =~ m#(?<=\^)/# ) {
- # Unix format
- return VMS::Filespec::vms_realpath($path);
- }
-
- # VMS format
-
- my $new_path = VMS::Filespec::vms_realname($path);
-
- # Perl expects directories to be in directory format
- $new_path = VMS::Filespec::pathify($new_path) if -d $path;
- return $new_path;
- }
-
- # Fallback to older algorithm if correct ones are not
- # available.
-
- # may need to turn foo.dir into [.foo]
- my $pathified = VMS::Filespec::pathify($path);
- $path = $pathified if defined $pathified;
-
- return VMS::Filespec::rmsexpand($path);
-}
-
-sub _os2_cwd {
- $ENV{'PWD'} = `cmd /c cd`;
- chomp $ENV{'PWD'};
- $ENV{'PWD'} =~ s:\\:/:g ;
- return $ENV{'PWD'};
-}
-
-sub _win32_cwd {
- if (defined &DynaLoader::boot_DynaLoader) {
- $ENV{'PWD'} = Win32::GetCwd();
- }
- else { # miniperl
- chomp($ENV{'PWD'} = `cd`);
- }
- $ENV{'PWD'} =~ s:\\:/:g ;
- return $ENV{'PWD'};
-}
-
-*_NT_cwd = defined &Win32::GetCwd ? \&_win32_cwd : \&_os2_cwd;
-
-sub _dos_cwd {
- if (!defined &Dos::GetCwd) {
- $ENV{'PWD'} = `command /c cd`;
- chomp $ENV{'PWD'};
- $ENV{'PWD'} =~ s:\\:/:g ;
- } else {
- $ENV{'PWD'} = Dos::GetCwd();
- }
- return $ENV{'PWD'};
-}
-
-sub _qnx_cwd {
- local $ENV{PATH} = '';
- local $ENV{CDPATH} = '';
- local $ENV{ENV} = '';
- $ENV{'PWD'} = `/usr/bin/fullpath -t`;
- chomp $ENV{'PWD'};
- return $ENV{'PWD'};
-}
-
-sub _qnx_abs_path {
- local $ENV{PATH} = '';
- local $ENV{CDPATH} = '';
- local $ENV{ENV} = '';
- my $path = @_ ? shift : '.';
- local *REALPATH;
-
- defined( open(REALPATH, '-|') || exec '/usr/bin/fullpath', '-t', $path ) or
- die "Can't open /usr/bin/fullpath: $!";
- my $realpath = <REALPATH>;
- close REALPATH;
- chomp $realpath;
- return $realpath;
-}
-
-sub _epoc_cwd {
- $ENV{'PWD'} = EPOC::getcwd();
- return $ENV{'PWD'};
-}
-
-
-# Now that all the base-level functions are set up, alias the
-# user-level functions to the right places
-
-if (exists $METHOD_MAP{$^O}) {
- my $map = $METHOD_MAP{$^O};
- foreach my $name (keys %$map) {
- local $^W = 0; # assignments trigger 'subroutine redefined' warning
- no strict 'refs';
- *{$name} = \&{$map->{$name}};
- }
-}
-
-# In case the XS version doesn't load.
-*abs_path = \&_perl_abs_path unless defined &abs_path;
-*getcwd = \&_perl_getcwd unless defined &getcwd;
-
-# added function alias for those of us more
-# used to the libc function. --tchrist 27-Jan-00
-*realpath = \&abs_path;
-
-1;
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Digest/SHA.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Digest/SHA.pm
deleted file mode 100644
index d57c16fce59..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Digest/SHA.pm
+++ /dev/null
@@ -1,669 +0,0 @@
-package Digest::SHA;
-
-require 5.003000;
-
-use strict;
-use integer;
-use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
-
-$VERSION = '5.47';
-
-require Exporter;
-require DynaLoader;
-@ISA = qw(Exporter DynaLoader);
-@EXPORT_OK = qw(
- hmac_sha1 hmac_sha1_base64 hmac_sha1_hex
- hmac_sha224 hmac_sha224_base64 hmac_sha224_hex
- hmac_sha256 hmac_sha256_base64 hmac_sha256_hex
- hmac_sha384 hmac_sha384_base64 hmac_sha384_hex
- hmac_sha512 hmac_sha512_base64 hmac_sha512_hex
- sha1 sha1_base64 sha1_hex
- sha224 sha224_base64 sha224_hex
- sha256 sha256_base64 sha256_hex
- sha384 sha384_base64 sha384_hex
- sha512 sha512_base64 sha512_hex);
-
-# If possible, inherit from Digest::base (which depends on MIME::Base64)
-
-*addfile = \&Addfile;
-
-eval {
- require MIME::Base64;
- require Digest::base;
- push(@ISA, 'Digest::base');
-};
-if ($@) {
- *hexdigest = \&Hexdigest;
- *b64digest = \&B64digest;
-}
-
-# The following routines aren't time-critical, so they can be left in Perl
-
-sub new {
- my($class, $alg) = @_;
- $alg =~ s/\D+//g if defined $alg;
- if (ref($class)) { # instance method
- unless (defined($alg) && ($alg != $class->algorithm)) {
- sharewind($$class);
- return($class);
- }
- shaclose($$class) if $$class;
- $$class = shaopen($alg) || return;
- return($class);
- }
- $alg = 1 unless defined $alg;
- my $state = shaopen($alg) || return;
- my $self = \$state;
- bless($self, $class);
- return($self);
-}
-
-sub DESTROY {
- my $self = shift;
- shaclose($$self) if $$self;
-}
-
-sub clone {
- my $self = shift;
- my $state = shadup($$self) || return;
- my $copy = \$state;
- bless($copy, ref($self));
- return($copy);
-}
-
-*reset = \&new;
-
-sub add_bits {
- my($self, $data, $nbits) = @_;
- unless (defined $nbits) {
- $nbits = length($data);
- $data = pack("B*", $data);
- }
- shawrite($data, $nbits, $$self);
- return($self);
-}
-
-sub _bail {
- my $msg = shift;
-
- require Carp;
- Carp::croak("$msg: $!");
-}
-
-sub _addfile { # this is "addfile" from Digest::base 1.00
- my ($self, $handle) = @_;
-
- my $n;
- my $buf = "";
-
- while (($n = read($handle, $buf, 4096))) {
- $self->add($buf);
- }
- _bail("Read failed") unless defined $n;
-
- $self;
-}
-
-sub Addfile {
- my ($self, $file, $mode) = @_;
-
- return(_addfile($self, $file)) unless ref(\$file) eq 'SCALAR';
-
- $mode = defined($mode) ? $mode : "";
- my ($binary, $portable) = map { $_ eq $mode } ("b", "p");
- my $text = -T $file;
-
- local *FH;
- # protect any leading or trailing whitespace in $file;
- # otherwise, 2-arg "open" will ignore them
- $file =~ s#^(\s)#./$1#;
- open(FH, "< $file\0") or _bail("Open failed");
- binmode(FH) if $binary || $portable;
-
- unless ($portable && $text) {
- $self->_addfile(*FH);
- close(FH);
- return($self);
- }
-
- my ($n1, $n2);
- my ($buf1, $buf2) = ("", "");
-
- while (($n1 = read(FH, $buf1, 4096))) {
- while (substr($buf1, -1) eq "\015") {
- $n2 = read(FH, $buf2, 4096);
- _bail("Read failed") unless defined $n2;
- last unless $n2;
- $buf1 .= $buf2;
- }
- $buf1 =~ s/\015?\015\012/\012/g; # DOS/Windows
- $buf1 =~ s/\015/\012/g; # early MacOS
- $self->add($buf1);
- }
- _bail("Read failed") unless defined $n1;
- close(FH);
-
- $self;
-}
-
-sub dump {
- my $self = shift;
- my $file = shift || "";
-
- shadump($file, $$self) || return;
- return($self);
-}
-
-sub load {
- my $class = shift;
- my $file = shift || "";
- if (ref($class)) { # instance method
- shaclose($$class) if $$class;
- $$class = shaload($file) || return;
- return($class);
- }
- my $state = shaload($file) || return;
- my $self = \$state;
- bless($self, $class);
- return($self);
-}
-
-Digest::SHA->bootstrap($VERSION);
-
-1;
-__END__
-
-=head1 NAME
-
-Digest::SHA - Perl extension for SHA-1/224/256/384/512
-
-=head1 SYNOPSIS
-
-In programs:
-
- # Functional interface
-
- use Digest::SHA qw(sha1 sha1_hex sha1_base64 ...);
-
- $digest = sha1($data);
- $digest = sha1_hex($data);
- $digest = sha1_base64($data);
-
- $digest = sha256($data);
- $digest = sha384_hex($data);
- $digest = sha512_base64($data);
-
- # Object-oriented
-
- use Digest::SHA;
-
- $sha = Digest::SHA->new($alg);
-
- $sha->add($data); # feed data into stream
-
- $sha->addfile(*F);
- $sha->addfile($filename);
-
- $sha->add_bits($bits);
- $sha->add_bits($data, $nbits);
-
- $sha_copy = $sha->clone; # if needed, make copy of
- $sha->dump($file); # current digest state,
- $sha->load($file); # or save it on disk
-
- $digest = $sha->digest; # compute digest
- $digest = $sha->hexdigest;
- $digest = $sha->b64digest;
-
-From the command line:
-
- $ shasum files
-
- $ shasum --help
-
-=head1 SYNOPSIS (HMAC-SHA)
-
- # Functional interface only
-
- use Digest::SHA qw(hmac_sha1 hmac_sha1_hex ...);
-
- $digest = hmac_sha1($data, $key);
- $digest = hmac_sha224_hex($data, $key);
- $digest = hmac_sha256_base64($data, $key);
-
-=head1 ABSTRACT
-
-Digest::SHA is a complete implementation of the NIST Secure Hash
-Standard. It gives Perl programmers a convenient way to calculate
-SHA-1, SHA-224, SHA-256, SHA-384, and SHA-512 message digests.
-The module can handle all types of input, including partial-byte
-data.
-
-=head1 DESCRIPTION
-
-Digest::SHA is written in C for speed. If your platform lacks a
-C compiler, you can install the functionally equivalent (but much
-slower) L<Digest::SHA::PurePerl> module.
-
-The programming interface is easy to use: it's the same one found
-in CPAN's L<Digest> module. So, if your applications currently
-use L<Digest::MD5> and you'd prefer the stronger security of SHA,
-it's a simple matter to convert them.
-
-The interface provides two ways to calculate digests: all-at-once,
-or in stages. To illustrate, the following short program computes
-the SHA-256 digest of "hello world" using each approach:
-
- use Digest::SHA qw(sha256_hex);
-
- $data = "hello world";
- @frags = split(//, $data);
-
- # all-at-once (Functional style)
- $digest1 = sha256_hex($data);
-
- # in-stages (OOP style)
- $state = Digest::SHA->new(256);
- for (@frags) { $state->add($_) }
- $digest2 = $state->hexdigest;
-
- print $digest1 eq $digest2 ?
- "whew!\n" : "oops!\n";
-
-To calculate the digest of an n-bit message where I<n> is not a
-multiple of 8, use the I<add_bits()> method. For example, consider
-the 446-bit message consisting of the bit-string "110" repeated
-148 times, followed by "11". Here's how to display its SHA-1
-digest:
-
- use Digest::SHA;
- $bits = "110" x 148 . "11";
- $sha = Digest::SHA->new(1)->add_bits($bits);
- print $sha->hexdigest, "\n";
-
-Note that for larger bit-strings, it's more efficient to use the
-two-argument version I<add_bits($data, $nbits)>, where I<$data> is
-in the customary packed binary format used for Perl strings.
-
-The module also lets you save intermediate SHA states to disk, or
-display them on standard output. The I<dump()> method generates
-portable, human-readable text describing the current state of
-computation. You can subsequently retrieve the file with I<load()>
-to resume where the calculation left off.
-
-To see what a state description looks like, just run the following:
-
- use Digest::SHA;
- Digest::SHA->new->add("Shaw" x 1962)->dump;
-
-As an added convenience, the Digest::SHA module offers routines to
-calculate keyed hashes using the HMAC-SHA-1/224/256/384/512
-algorithms. These services exist in functional form only, and
-mimic the style and behavior of the I<sha()>, I<sha_hex()>, and
-I<sha_base64()> functions.
-
- # Test vector from draft-ietf-ipsec-ciph-sha-256-01.txt
-
- use Digest::SHA qw(hmac_sha256_hex);
- print hmac_sha256_hex("Hi There", chr(0x0b) x 32), "\n";
-
-=head1 NIST STATEMENT ON SHA-1
-
-I<NIST was recently informed that researchers had discovered a way
-to "break" the current Federal Information Processing Standard SHA-1
-algorithm, which has been in effect since 1994. The researchers
-have not yet published their complete results, so NIST has not
-confirmed these findings. However, the researchers are a reputable
-research team with expertise in this area.>
-
-I<Due to advances in computing power, NIST already planned to phase
-out SHA-1 in favor of the larger and stronger hash functions (SHA-224,
-SHA-256, SHA-384 and SHA-512) by 2010. New developments should use
-the larger and stronger hash functions.>
-
-ref. L<http://www.csrc.nist.gov/pki/HashWorkshop/NIST%20Statement/Burr_Mar2005.html>
-
-=head1 PADDING OF BASE64 DIGESTS
-
-By convention, CPAN Digest modules do B<not> pad their Base64 output.
-Problems can occur when feeding such digests to other software that
-expects properly padded Base64 encodings.
-
-For the time being, any necessary padding must be done by the user.
-Fortunately, this is a simple operation: if the length of a Base64-encoded
-digest isn't a multiple of 4, simply append "=" characters to the end
-of the digest until it is:
-
- while (length($b64_digest) % 4) {
- $b64_digest .= '=';
- }
-
-To illustrate, I<sha256_base64("abc")> is computed to be
-
- ungWv48Bz+pBQUDeXa4iI7ADYaOWF3qctBD/YfIAFa0
-
-which has a length of 43. So, the properly padded version is
-
- ungWv48Bz+pBQUDeXa4iI7ADYaOWF3qctBD/YfIAFa0=
-
-=head1 EXPORT
-
-None by default.
-
-=head1 EXPORTABLE FUNCTIONS
-
-Provided your C compiler supports a 64-bit type (e.g. the I<long
-long> of C99, or I<__int64> used by Microsoft C/C++), all of these
-functions will be available for use. Otherwise, you won't be able
-to perform the SHA-384 and SHA-512 transforms, both of which require
-64-bit operations.
-
-I<Functional style>
-
-=over 4
-
-=item B<sha1($data, ...)>
-
-=item B<sha224($data, ...)>
-
-=item B<sha256($data, ...)>
-
-=item B<sha384($data, ...)>
-
-=item B<sha512($data, ...)>
-
-Logically joins the arguments into a single string, and returns
-its SHA-1/224/256/384/512 digest encoded as a binary string.
-
-=item B<sha1_hex($data, ...)>
-
-=item B<sha224_hex($data, ...)>
-
-=item B<sha256_hex($data, ...)>
-
-=item B<sha384_hex($data, ...)>
-
-=item B<sha512_hex($data, ...)>
-
-Logically joins the arguments into a single string, and returns
-its SHA-1/224/256/384/512 digest encoded as a hexadecimal string.
-
-=item B<sha1_base64($data, ...)>
-
-=item B<sha224_base64($data, ...)>
-
-=item B<sha256_base64($data, ...)>
-
-=item B<sha384_base64($data, ...)>
-
-=item B<sha512_base64($data, ...)>
-
-Logically joins the arguments into a single string, and returns
-its SHA-1/224/256/384/512 digest encoded as a Base64 string.
-
-It's important to note that the resulting string does B<not> contain
-the padding characters typical of Base64 encodings. This omission is
-deliberate, and is done to maintain compatibility with the family of
-CPAN Digest modules. See L</"PADDING OF BASE64 DIGESTS"> for details.
-
-=back
-
-I<OOP style>
-
-=over 4
-
-=item B<new($alg)>
-
-Returns a new Digest::SHA object. Allowed values for I<$alg> are
-1, 224, 256, 384, or 512. It's also possible to use common string
-representations of the algorithm (e.g. "sha256", "SHA-384"). If
-the argument is missing, SHA-1 will be used by default.
-
-Invoking I<new> as an instance method will not create a new object;
-instead, it will simply reset the object to the initial state
-associated with I<$alg>. If the argument is missing, the object
-will continue using the same algorithm that was selected at creation.
-
-=item B<reset($alg)>
-
-This method has exactly the same effect as I<new($alg)>. In fact,
-I<reset> is just an alias for I<new>.
-
-=item B<hashsize>
-
-Returns the number of digest bits for this object. The values are
-160, 224, 256, 384, and 512 for SHA-1, SHA-224, SHA-256, SHA-384,
-and SHA-512, respectively.
-
-=item B<algorithm>
-
-Returns the digest algorithm for this object. The values are 1,
-224, 256, 384, and 512 for SHA-1, SHA-224, SHA-256, SHA-384, and
-SHA-512, respectively.
-
-=item B<clone>
-
-Returns a duplicate copy of the object.
-
-=item B<add($data, ...)>
-
-Logically joins the arguments into a single string, and uses it to
-update the current digest state. In other words, the following
-statements have the same effect:
-
- $sha->add("a"); $sha->add("b"); $sha->add("c");
- $sha->add("a")->add("b")->add("c");
- $sha->add("a", "b", "c");
- $sha->add("abc");
-
-The return value is the updated object itself.
-
-=item B<add_bits($data, $nbits)>
-
-=item B<add_bits($bits)>
-
-Updates the current digest state by appending bits to it. The
-return value is the updated object itself.
-
-The first form causes the most-significant I<$nbits> of I<$data>
-to be appended to the stream. The I<$data> argument is in the
-customary binary format used for Perl strings.
-
-The second form takes an ASCII string of "0" and "1" characters as
-its argument. It's equivalent to
-
- $sha->add_bits(pack("B*", $bits), length($bits));
-
-So, the following two statements do the same thing:
-
- $sha->add_bits("111100001010");
- $sha->add_bits("\xF0\xA0", 12);
-
-=item B<addfile(*FILE)>
-
-Reads from I<FILE> until EOF, and appends that data to the current
-state. The return value is the updated object itself.
-
-=item B<addfile($filename [, $mode])>
-
-Reads the contents of I<$filename>, and appends that data to the current
-state. The return value is the updated object itself.
-
-By default, I<$filename> is simply opened and read; no special modes
-or I/O disciplines are used. To change this, set the optional I<$mode>
-argument to one of the following values:
-
- "b" read file in binary mode
-
- "p" use portable mode
-
-The "p" mode is handy since it ensures that the digest value of
-I<$filename> will be the same when computed on different operating
-systems. It accomplishes this by internally translating all newlines in
-text files to UNIX format before calculating the digest. Binary files
-are read in raw mode with no translation whatsoever.
-
-For a fuller discussion of newline formats, refer to CPAN module
-L<File::LocalizeNewlines>. Its "universal line separator" regex forms
-the basis of I<addfile>'s portable mode processing.
-
-=item B<dump($filename)>
-
-Provides persistent storage of intermediate SHA states by writing
-a portable, human-readable representation of the current state to
-I<$filename>. If the argument is missing, or equal to the empty
-string, the state information will be written to STDOUT.
-
-=item B<load($filename)>
-
-Returns a Digest::SHA object representing the intermediate SHA
-state that was previously dumped to I<$filename>. If called as a
-class method, a new object is created; if called as an instance
-method, the object is reset to the state contained in I<$filename>.
-If the argument is missing, or equal to the empty string, the state
-information will be read from STDIN.
-
-=item B<digest>
-
-Returns the digest encoded as a binary string.
-
-Note that the I<digest> method is a read-once operation. Once it
-has been performed, the Digest::SHA object is automatically reset
-in preparation for calculating another digest value. Call
-I<$sha-E<gt>clone-E<gt>digest> if it's necessary to preserve the
-original digest state.
-
-=item B<hexdigest>
-
-Returns the digest encoded as a hexadecimal string.
-
-Like I<digest>, this method is a read-once operation. Call
-I<$sha-E<gt>clone-E<gt>hexdigest> if it's necessary to preserve
-the original digest state.
-
-This method is inherited if L<Digest::base> is installed on your
-system. Otherwise, a functionally equivalent substitute is used.
-
-=item B<b64digest>
-
-Returns the digest encoded as a Base64 string.
-
-Like I<digest>, this method is a read-once operation. Call
-I<$sha-E<gt>clone-E<gt>b64digest> if it's necessary to preserve
-the original digest state.
-
-This method is inherited if L<Digest::base> is installed on your
-system. Otherwise, a functionally equivalent substitute is used.
-
-It's important to note that the resulting string does B<not> contain
-the padding characters typical of Base64 encodings. This omission is
-deliberate, and is done to maintain compatibility with the family of
-CPAN Digest modules. See L</"PADDING OF BASE64 DIGESTS"> for details.
-
-=back
-
-I<HMAC-SHA-1/224/256/384/512>
-
-=over 4
-
-=item B<hmac_sha1($data, $key)>
-
-=item B<hmac_sha224($data, $key)>
-
-=item B<hmac_sha256($data, $key)>
-
-=item B<hmac_sha384($data, $key)>
-
-=item B<hmac_sha512($data, $key)>
-
-Returns the HMAC-SHA-1/224/256/384/512 digest of I<$data>/I<$key>,
-with the result encoded as a binary string. Multiple I<$data>
-arguments are allowed, provided that I<$key> is the last argument
-in the list.
-
-=item B<hmac_sha1_hex($data, $key)>
-
-=item B<hmac_sha224_hex($data, $key)>
-
-=item B<hmac_sha256_hex($data, $key)>
-
-=item B<hmac_sha384_hex($data, $key)>
-
-=item B<hmac_sha512_hex($data, $key)>
-
-Returns the HMAC-SHA-1/224/256/384/512 digest of I<$data>/I<$key>,
-with the result encoded as a hexadecimal string. Multiple I<$data>
-arguments are allowed, provided that I<$key> is the last argument
-in the list.
-
-=item B<hmac_sha1_base64($data, $key)>
-
-=item B<hmac_sha224_base64($data, $key)>
-
-=item B<hmac_sha256_base64($data, $key)>
-
-=item B<hmac_sha384_base64($data, $key)>
-
-=item B<hmac_sha512_base64($data, $key)>
-
-Returns the HMAC-SHA-1/224/256/384/512 digest of I<$data>/I<$key>,
-with the result encoded as a Base64 string. Multiple I<$data>
-arguments are allowed, provided that I<$key> is the last argument
-in the list.
-
-It's important to note that the resulting string does B<not> contain
-the padding characters typical of Base64 encodings. This omission is
-deliberate, and is done to maintain compatibility with the family of
-CPAN Digest modules. See L</"PADDING OF BASE64 DIGESTS"> for details.
-
-=back
-
-=head1 SEE ALSO
-
-L<Digest>, L<Digest::SHA::PurePerl>
-
-The Secure Hash Standard (FIPS PUB 180-2) can be found at:
-
-L<http://csrc.nist.gov/publications/fips/fips180-2/fips180-2withchangenotice.pdf>
-
-The Keyed-Hash Message Authentication Code (HMAC):
-
-L<http://csrc.nist.gov/publications/fips/fips198/fips-198a.pdf>
-
-=head1 AUTHOR
-
- Mark Shelor <mshelor@cpan.org>
-
-=head1 ACKNOWLEDGMENTS
-
-The author is particularly grateful to
-
- Gisle Aas
- Chris Carey
- Alexandr Ciornii
- Jim Doble
- Julius Duque
- Jeffrey Friedl
- Robert Gilmour
- Brian Gladman
- Adam Kennedy
- Andy Lester
- Alex Muntada
- Steve Peters
- Chris Skiscim
- Martin Thurn
- Gunnar Wolf
- Adam Woodbury
-
-for their valuable comments and suggestions.
-
-=head1 COPYRIGHT AND LICENSE
-
-Copyright (C) 2003-2008 Mark Shelor
-
-This library is free software; you can redistribute it and/or modify
-it under the same terms as Perl itself.
-
-L<perlartistic>
-
-=cut
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/File/Spec.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/File/Spec.pm
deleted file mode 100644
index 53d4a5a22b2..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/File/Spec.pm
+++ /dev/null
@@ -1,336 +0,0 @@
-package File::Spec;
-
-use strict;
-use vars qw(@ISA $VERSION);
-
-$VERSION = '3.2701';
-$VERSION = eval $VERSION;
-
-my %module = (MacOS => 'Mac',
- MSWin32 => 'Win32',
- os2 => 'OS2',
- VMS => 'VMS',
- epoc => 'Epoc',
- NetWare => 'Win32', # Yes, File::Spec::Win32 works on NetWare.
- symbian => 'Win32', # Yes, File::Spec::Win32 works on symbian.
- dos => 'OS2', # Yes, File::Spec::OS2 works on DJGPP.
- cygwin => 'Cygwin');
-
-
-my $module = $module{$^O} || 'Unix';
-
-require "File/Spec/$module.pm";
-@ISA = ("File::Spec::$module");
-
-1;
-
-__END__
-
-=head1 NAME
-
-File::Spec - portably perform operations on file names
-
-=head1 SYNOPSIS
-
- use File::Spec;
-
- $x=File::Spec->catfile('a', 'b', 'c');
-
-which returns 'a/b/c' under Unix. Or:
-
- use File::Spec::Functions;
-
- $x = catfile('a', 'b', 'c');
-
-=head1 DESCRIPTION
-
-This module is designed to support operations commonly performed on file
-specifications (usually called "file names", but not to be confused with the
-contents of a file, or Perl's file handles), such as concatenating several
-directory and file names into a single path, or determining whether a path
-is rooted. It is based on code directly taken from MakeMaker 5.17, code
-written by Andreas KE<ouml>nig, Andy Dougherty, Charles Bailey, Ilya
-Zakharevich, Paul Schinder, and others.
-
-Since these functions are different for most operating systems, each set of
-OS specific routines is available in a separate module, including:
-
- File::Spec::Unix
- File::Spec::Mac
- File::Spec::OS2
- File::Spec::Win32
- File::Spec::VMS
-
-The module appropriate for the current OS is automatically loaded by
-File::Spec. Since some modules (like VMS) make use of facilities available
-only under that OS, it may not be possible to load all modules under all
-operating systems.
-
-Since File::Spec is object oriented, subroutines should not be called directly,
-as in:
-
- File::Spec::catfile('a','b');
-
-but rather as class methods:
-
- File::Spec->catfile('a','b');
-
-For simple uses, L<File::Spec::Functions> provides convenient functional
-forms of these methods.
-
-=head1 METHODS
-
-=over 2
-
-=item canonpath
-X<canonpath>
-
-No physical check on the filesystem, but a logical cleanup of a
-path.
-
- $cpath = File::Spec->canonpath( $path ) ;
-
-Note that this does *not* collapse F<x/../y> sections into F<y>. This
-is by design. If F</foo> on your system is a symlink to F</bar/baz>,
-then F</foo/../quux> is actually F</bar/quux>, not F</quux> as a naive
-F<../>-removal would give you. If you want to do this kind of
-processing, you probably want C<Cwd>'s C<realpath()> function to
-actually traverse the filesystem cleaning up paths like this.
-
-=item catdir
-X<catdir>
-
-Concatenate two or more directory names to form a complete path ending
-with a directory. But remove the trailing slash from the resulting
-string, because it doesn't look good, isn't necessary and confuses
-OS/2. Of course, if this is the root directory, don't cut off the
-trailing slash :-)
-
- $path = File::Spec->catdir( @directories );
-
-=item catfile
-X<catfile>
-
-Concatenate one or more directory names and a filename to form a
-complete path ending with a filename
-
- $path = File::Spec->catfile( @directories, $filename );
-
-=item curdir
-X<curdir>
-
-Returns a string representation of the current directory.
-
- $curdir = File::Spec->curdir();
-
-=item devnull
-X<devnull>
-
-Returns a string representation of the null device.
-
- $devnull = File::Spec->devnull();
-
-=item rootdir
-X<rootdir>
-
-Returns a string representation of the root directory.
-
- $rootdir = File::Spec->rootdir();
-
-=item tmpdir
-X<tmpdir>
-
-Returns a string representation of the first writable directory from a
-list of possible temporary directories. Returns the current directory
-if no writable temporary directories are found. The list of directories
-checked depends on the platform; e.g. File::Spec::Unix checks C<$ENV{TMPDIR}>
-(unless taint is on) and F</tmp>.
-
- $tmpdir = File::Spec->tmpdir();
-
-=item updir
-X<updir>
-
-Returns a string representation of the parent directory.
-
- $updir = File::Spec->updir();
-
-=item no_upwards
-
-Given a list of file names, strip out those that refer to a parent
-directory. (Does not strip symlinks, only '.', '..', and equivalents.)
-
- @paths = File::Spec->no_upwards( @paths );
-
-=item case_tolerant
-
-Returns a true or false value indicating, respectively, that alphabetic
-case is not or is significant when comparing file specifications.
-
- $is_case_tolerant = File::Spec->case_tolerant();
-
-=item file_name_is_absolute
-
-Takes as its argument a path, and returns true if it is an absolute path.
-
- $is_absolute = File::Spec->file_name_is_absolute( $path );
-
-This does not consult the local filesystem on Unix, Win32, OS/2, or
-Mac OS (Classic). It does consult the working environment for VMS
-(see L<File::Spec::VMS/file_name_is_absolute>).
-
-=item path
-X<path>
-
-Takes no argument. Returns the environment variable C<PATH> (or the local
-platform's equivalent) as a list.
-
- @PATH = File::Spec->path();
-
-=item join
-X<join, path>
-
-join is the same as catfile.
-
-=item splitpath
-X<splitpath> X<split, path>
-
-Splits a path in to volume, directory, and filename portions. On systems
-with no concept of volume, returns '' for volume.
-
- ($volume,$directories,$file) = File::Spec->splitpath( $path );
- ($volume,$directories,$file) = File::Spec->splitpath( $path, $no_file );
-
-For systems with no syntax differentiating filenames from directories,
-assumes that the last file is a path unless C<$no_file> is true or a
-trailing separator or F</.> or F</..> is present. On Unix, this means that C<$no_file>
-true makes this return ( '', $path, '' ).
-
-The directory portion may or may not be returned with a trailing '/'.
-
-The results can be passed to L</catpath()> to get back a path equivalent to
-(usually identical to) the original path.
-
-=item splitdir
-X<splitdir> X<split, dir>
-
-The opposite of L</catdir()>.
-
- @dirs = File::Spec->splitdir( $directories );
-
-C<$directories> must be only the directory portion of the path on systems
-that have the concept of a volume or that have path syntax that differentiates
-files from directories.
-
-Unlike just splitting the directories on the separator, empty
-directory names (C<''>) can be returned, because these are significant
-on some OSes.
-
-=item catpath()
-
-Takes volume, directory and file portions and returns an entire path. Under
-Unix, C<$volume> is ignored, and directory and file are concatenated. A '/' is
-inserted if need be. On other OSes, C<$volume> is significant.
-
- $full_path = File::Spec->catpath( $volume, $directory, $file );
-
-=item abs2rel
-X<abs2rel> X<absolute, path> X<relative, path>
-
-Takes a destination path and an optional base path returns a relative path
-from the base path to the destination path:
-
- $rel_path = File::Spec->abs2rel( $path ) ;
- $rel_path = File::Spec->abs2rel( $path, $base ) ;
-
-If C<$base> is not present or '', then L<Cwd::cwd()|Cwd> is used. If C<$base> is
-relative, then it is converted to absolute form using
-L</rel2abs()>. This means that it is taken to be relative to
-L<Cwd::cwd()|Cwd>.
-
-On systems with the concept of volume, if C<$path> and C<$base> appear to be
-on two different volumes, we will not attempt to resolve the two
-paths, and we will instead simply return C<$path>. Note that previous
-versions of this module ignored the volume of C<$base>, which resulted in
-garbage results part of the time.
-
-On systems that have a grammar that indicates filenames, this ignores the
-C<$base> filename as well. Otherwise all path components are assumed to be
-directories.
-
-If C<$path> is relative, it is converted to absolute form using L</rel2abs()>.
-This means that it is taken to be relative to L<Cwd::cwd()|Cwd>.
-
-No checks against the filesystem are made. On VMS, there is
-interaction with the working environment, as logicals and
-macros are expanded.
-
-Based on code written by Shigio Yamaguchi.
-
-=item rel2abs()
-X<rel2abs> X<absolute, path> X<relative, path>
-
-Converts a relative path to an absolute path.
-
- $abs_path = File::Spec->rel2abs( $path ) ;
- $abs_path = File::Spec->rel2abs( $path, $base ) ;
-
-If C<$base> is not present or '', then L<Cwd::cwd()|Cwd> is used. If C<$base> is relative,
-then it is converted to absolute form using L</rel2abs()>. This means that it
-is taken to be relative to L<Cwd::cwd()|Cwd>.
-
-On systems with the concept of volume, if C<$path> and C<$base> appear to be
-on two different volumes, we will not attempt to resolve the two
-paths, and we will instead simply return C<$path>. Note that previous
-versions of this module ignored the volume of C<$base>, which resulted in
-garbage results part of the time.
-
-On systems that have a grammar that indicates filenames, this ignores the
-C<$base> filename as well. Otherwise all path components are assumed to be
-directories.
-
-If C<$path> is absolute, it is cleaned up and returned using L</canonpath()>.
-
-No checks against the filesystem are made. On VMS, there is
-interaction with the working environment, as logicals and
-macros are expanded.
-
-Based on code written by Shigio Yamaguchi.
-
-=back
-
-For further information, please see L<File::Spec::Unix>,
-L<File::Spec::Mac>, L<File::Spec::OS2>, L<File::Spec::Win32>, or
-L<File::Spec::VMS>.
-
-=head1 SEE ALSO
-
-L<File::Spec::Unix>, L<File::Spec::Mac>, L<File::Spec::OS2>,
-L<File::Spec::Win32>, L<File::Spec::VMS>, L<File::Spec::Functions>,
-L<ExtUtils::MakeMaker>
-
-=head1 AUTHOR
-
-Currently maintained by Ken Williams C<< <KWILLIAMS@cpan.org> >>.
-
-The vast majority of the code was written by
-Kenneth Albanowski C<< <kjahds@kjahds.com> >>,
-Andy Dougherty C<< <doughera@lafayette.edu> >>,
-Andreas KE<ouml>nig C<< <A.Koenig@franz.ww.TU-Berlin.DE> >>,
-Tim Bunce C<< <Tim.Bunce@ig.co.uk> >>.
-VMS support by Charles Bailey C<< <bailey@newman.upenn.edu> >>.
-OS/2 support by Ilya Zakharevich C<< <ilya@math.ohio-state.edu> >>.
-Mac support by Paul Schinder C<< <schinder@pobox.com> >>, and
-Thomas Wegner C<< <wegner_thomas@yahoo.com> >>.
-abs2rel() and rel2abs() written by Shigio Yamaguchi C<< <shigio@tamacom.com> >>,
-modified by Barrie Slaymaker C<< <barries@slaysys.com> >>.
-splitpath(), splitdir(), catpath() and catdir() by Barrie Slaymaker.
-
-=head1 COPYRIGHT
-
-Copyright (c) 2004 by the Perl 5 Porters. 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/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/File/Spec/Cygwin.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/File/Spec/Cygwin.pm
deleted file mode 100644
index 1b2c0459603..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/File/Spec/Cygwin.pm
+++ /dev/null
@@ -1,154 +0,0 @@
-package File::Spec::Cygwin;
-
-use strict;
-use vars qw(@ISA $VERSION);
-require File::Spec::Unix;
-
-$VERSION = '3.2701';
-
-@ISA = qw(File::Spec::Unix);
-
-=head1 NAME
-
-File::Spec::Cygwin - methods for Cygwin file specs
-
-=head1 SYNOPSIS
-
- require File::Spec::Cygwin; # Done internally by File::Spec if needed
-
-=head1 DESCRIPTION
-
-See L<File::Spec> and L<File::Spec::Unix>. This package overrides the
-implementation of these methods, not the semantics.
-
-This module is still in beta. Cygwin-knowledgeable folks are invited
-to offer patches and suggestions.
-
-=cut
-
-=pod
-
-=over 4
-
-=item canonpath
-
-Any C<\> (backslashes) are converted to C</> (forward slashes),
-and then File::Spec::Unix canonpath() is called on the result.
-
-=cut
-
-sub canonpath {
- my($self,$path) = @_;
- return unless defined $path;
-
- $path =~ s|\\|/|g;
-
- # Handle network path names beginning with double slash
- my $node = '';
- if ( $path =~ s@^(//[^/]+)(?:/|\z)@/@s ) {
- $node = $1;
- }
- return $node . $self->SUPER::canonpath($path);
-}
-
-sub catdir {
- my $self = shift;
- return unless @_;
-
- # Don't create something that looks like a //network/path
- if ($_[0] and ($_[0] eq '/' or $_[0] eq '\\')) {
- shift;
- return $self->SUPER::catdir('', @_);
- }
-
- $self->SUPER::catdir(@_);
-}
-
-=pod
-
-=item file_name_is_absolute
-
-True is returned if the file name begins with C<drive_letter:>,
-and if not, File::Spec::Unix file_name_is_absolute() is called.
-
-=cut
-
-
-sub file_name_is_absolute {
- my ($self,$file) = @_;
- return 1 if $file =~ m{^([a-z]:)?[\\/]}is; # C:/test
- return $self->SUPER::file_name_is_absolute($file);
-}
-
-=item tmpdir (override)
-
-Returns a string representation of the first existing directory
-from the following list:
-
- $ENV{TMPDIR}
- /tmp
- $ENV{'TMP'}
- $ENV{'TEMP'}
- C:/temp
-
-Since Perl 5.8.0, if running under taint mode, and if the environment
-variables are tainted, they are not used.
-
-=cut
-
-my $tmpdir;
-sub tmpdir {
- return $tmpdir if defined $tmpdir;
- $tmpdir = $_[0]->_tmpdir( $ENV{TMPDIR}, "/tmp", $ENV{'TMP'}, $ENV{'TEMP'}, 'C:/temp' );
-}
-
-=item case_tolerant
-
-Override Unix. Cygwin case-tolerance depends on managed mount settings and
-as with MsWin32 on GetVolumeInformation() $ouFsFlags == FS_CASE_SENSITIVE,
-indicating the case significance when comparing file specifications.
-Default: 1
-
-=cut
-
-sub case_tolerant () {
- return 1 unless $^O eq 'cygwin'
- and defined &Cygwin::mount_flags;
-
- my $drive = shift;
- if (! $drive) {
- my @flags = split(/,/, Cygwin::mount_flags('/cygwin'));
- my $prefix = pop(@flags);
- if (! $prefix || $prefix eq 'cygdrive') {
- $drive = '/cygdrive/c';
- } elsif ($prefix eq '/') {
- $drive = '/c';
- } else {
- $drive = "$prefix/c";
- }
- }
- my $mntopts = Cygwin::mount_flags($drive);
- if ($mntopts and ($mntopts =~ /,managed/)) {
- return 0;
- }
- eval { require Win32API::File; } or return 1;
- my $osFsType = "\0"x256;
- my $osVolName = "\0"x256;
- my $ouFsFlags = 0;
- Win32API::File::GetVolumeInformation($drive, $osVolName, 256, [], [], $ouFsFlags, $osFsType, 256 );
- if ($ouFsFlags & Win32API::File::FS_CASE_SENSITIVE()) { return 0; }
- else { return 1; }
-}
-
-=back
-
-=head1 COPYRIGHT
-
-Copyright (c) 2004,2007 by the Perl 5 Porters. All rights reserved.
-
-This program is free software; you can redistribute it and/or modify
-it under the same terms as Perl itself.
-
-=cut
-
-1;
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/File/Spec/Epoc.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/File/Spec/Epoc.pm
deleted file mode 100644
index 1e0ad188bd2..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/File/Spec/Epoc.pm
+++ /dev/null
@@ -1,78 +0,0 @@
-package File::Spec::Epoc;
-
-use strict;
-use vars qw($VERSION @ISA);
-
-$VERSION = '3.2701';
-
-require File::Spec::Unix;
-@ISA = qw(File::Spec::Unix);
-
-=head1 NAME
-
-File::Spec::Epoc - methods for Epoc file specs
-
-=head1 SYNOPSIS
-
- require File::Spec::Epoc; # Done internally by File::Spec if needed
-
-=head1 DESCRIPTION
-
-See File::Spec::Unix for a documentation of the methods provided
-there. This package overrides the implementation of these methods, not
-the semantics.
-
-This package is still work in progress ;-)
-
-=cut
-
-sub case_tolerant {
- return 1;
-}
-
-=pod
-
-=over 4
-
-=item canonpath()
-
-No physical check on the filesystem, but a logical cleanup of a
-path. On UNIX eliminated successive slashes and successive "/.".
-
-=back
-
-=cut
-
-sub canonpath {
- my ($self,$path) = @_;
- return unless defined $path;
-
- $path =~ s|/+|/|g; # xx////xx -> xx/xx
- $path =~ s|(/\.)+/|/|g; # xx/././xx -> xx/xx
- $path =~ s|^(\./)+||s unless $path eq "./"; # ./xx -> xx
- $path =~ s|^/(\.\./)+|/|s; # /../../xx -> xx
- $path =~ s|/\Z(?!\n)|| unless $path eq "/"; # xx/ -> xx
- return $path;
-}
-
-=pod
-
-=head1 AUTHOR
-
-o.flebbe@gmx.de
-
-=head1 COPYRIGHT
-
-Copyright (c) 2004 by the Perl 5 Porters. 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
-
-See L<File::Spec> and L<File::Spec::Unix>. This package overrides the
-implementation of these methods, not the semantics.
-
-=cut
-
-1;
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/File/Spec/Functions.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/File/Spec/Functions.pm
deleted file mode 100644
index ab335e16a05..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/File/Spec/Functions.pm
+++ /dev/null
@@ -1,109 +0,0 @@
-package File::Spec::Functions;
-
-use File::Spec;
-use strict;
-
-use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
-
-$VERSION = '3.2701';
-
-require Exporter;
-
-@ISA = qw(Exporter);
-
-@EXPORT = qw(
- canonpath
- catdir
- catfile
- curdir
- rootdir
- updir
- no_upwards
- file_name_is_absolute
- path
-);
-
-@EXPORT_OK = qw(
- devnull
- tmpdir
- splitpath
- splitdir
- catpath
- abs2rel
- rel2abs
- case_tolerant
-);
-
-%EXPORT_TAGS = ( ALL => [ @EXPORT_OK, @EXPORT ] );
-
-foreach my $meth (@EXPORT, @EXPORT_OK) {
- my $sub = File::Spec->can($meth);
- no strict 'refs';
- *{$meth} = sub {&$sub('File::Spec', @_)};
-}
-
-
-1;
-__END__
-
-=head1 NAME
-
-File::Spec::Functions - portably perform operations on file names
-
-=head1 SYNOPSIS
-
- use File::Spec::Functions;
- $x = catfile('a','b');
-
-=head1 DESCRIPTION
-
-This module exports convenience functions for all of the class methods
-provided by File::Spec.
-
-For a reference of available functions, please consult L<File::Spec::Unix>,
-which contains the entire set, and which is inherited by the modules for
-other platforms. For further information, please see L<File::Spec::Mac>,
-L<File::Spec::OS2>, L<File::Spec::Win32>, or L<File::Spec::VMS>.
-
-=head2 Exports
-
-The following functions are exported by default.
-
- canonpath
- catdir
- catfile
- curdir
- rootdir
- updir
- no_upwards
- file_name_is_absolute
- path
-
-
-The following functions are exported only by request.
-
- devnull
- tmpdir
- splitpath
- splitdir
- catpath
- abs2rel
- rel2abs
- case_tolerant
-
-All the functions may be imported using the C<:ALL> tag.
-
-=head1 COPYRIGHT
-
-Copyright (c) 2004 by the Perl 5 Porters. 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
-
-File::Spec, File::Spec::Unix, File::Spec::Mac, File::Spec::OS2,
-File::Spec::Win32, File::Spec::VMS, ExtUtils::MakeMaker
-
-=cut
-
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/File/Spec/Mac.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/File/Spec/Mac.pm
deleted file mode 100644
index 97fa6766263..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/File/Spec/Mac.pm
+++ /dev/null
@@ -1,780 +0,0 @@
-package File::Spec::Mac;
-
-use strict;
-use vars qw(@ISA $VERSION);
-require File::Spec::Unix;
-
-$VERSION = '3.2701';
-
-@ISA = qw(File::Spec::Unix);
-
-my $macfiles;
-if ($^O eq 'MacOS') {
- $macfiles = eval { require Mac::Files };
-}
-
-sub case_tolerant { 1 }
-
-
-=head1 NAME
-
-File::Spec::Mac - File::Spec for Mac OS (Classic)
-
-=head1 SYNOPSIS
-
- require File::Spec::Mac; # Done internally by File::Spec if needed
-
-=head1 DESCRIPTION
-
-Methods for manipulating file specifications.
-
-=head1 METHODS
-
-=over 2
-
-=item canonpath
-
-On Mac OS, there's nothing to be done. Returns what it's given.
-
-=cut
-
-sub canonpath {
- my ($self,$path) = @_;
- return $path;
-}
-
-=item catdir()
-
-Concatenate two or more directory names to form a path separated by colons
-(":") ending with a directory. Resulting paths are B<relative> by default,
-but can be forced to be absolute (but avoid this, see below). Automatically
-puts a trailing ":" on the end of the complete path, because that's what's
-done in MacPerl's environment and helps to distinguish a file path from a
-directory path.
-
-B<IMPORTANT NOTE:> Beginning with version 1.3 of this module, the resulting
-path is relative by default and I<not> absolute. This decision was made due
-to portability reasons. Since C<File::Spec-E<gt>catdir()> returns relative paths
-on all other operating systems, it will now also follow this convention on Mac
-OS. Note that this may break some existing scripts.
-
-The intended purpose of this routine is to concatenate I<directory names>.
-But because of the nature of Macintosh paths, some additional possibilities
-are allowed to make using this routine give reasonable results for some
-common situations. In other words, you are also allowed to concatenate
-I<paths> instead of directory names (strictly speaking, a string like ":a"
-is a path, but not a name, since it contains a punctuation character ":").
-
-So, beside calls like
-
- catdir("a") = ":a:"
- catdir("a","b") = ":a:b:"
- catdir() = "" (special case)
-
-calls like the following
-
- catdir(":a:") = ":a:"
- catdir(":a","b") = ":a:b:"
- catdir(":a:","b") = ":a:b:"
- catdir(":a:",":b:") = ":a:b:"
- catdir(":") = ":"
-
-are allowed.
-
-Here are the rules that are used in C<catdir()>; note that we try to be as
-compatible as possible to Unix:
-
-=over 2
-
-=item 1.
-
-The resulting path is relative by default, i.e. the resulting path will have a
-leading colon.
-
-=item 2.
-
-A trailing colon is added automatically to the resulting path, to denote a
-directory.
-
-=item 3.
-
-Generally, each argument has one leading ":" and one trailing ":"
-removed (if any). They are then joined together by a ":". Special
-treatment applies for arguments denoting updir paths like "::lib:",
-see (4), or arguments consisting solely of colons ("colon paths"),
-see (5).
-
-=item 4.
-
-When an updir path like ":::lib::" is passed as argument, the number
-of directories to climb up is handled correctly, not removing leading
-or trailing colons when necessary. E.g.
-
- catdir(":::a","::b","c") = ":::a::b:c:"
- catdir(":::a::","::b","c") = ":::a:::b:c:"
-
-=item 5.
-
-Adding a colon ":" or empty string "" to a path at I<any> position
-doesn't alter the path, i.e. these arguments are ignored. (When a ""
-is passed as the first argument, it has a special meaning, see
-(6)). This way, a colon ":" is handled like a "." (curdir) on Unix,
-while an empty string "" is generally ignored (see
-C<Unix-E<gt>canonpath()> ). Likewise, a "::" is handled like a ".."
-(updir), and a ":::" is handled like a "../.." etc. E.g.
-
- catdir("a",":",":","b") = ":a:b:"
- catdir("a",":","::",":b") = ":a::b:"
-
-=item 6.
-
-If the first argument is an empty string "" or is a volume name, i.e. matches
-the pattern /^[^:]+:/, the resulting path is B<absolute>.
-
-=item 7.
-
-Passing an empty string "" as the first argument to C<catdir()> is
-like passingC<File::Spec-E<gt>rootdir()> as the first argument, i.e.
-
- catdir("","a","b") is the same as
-
- catdir(rootdir(),"a","b").
-
-This is true on Unix, where C<catdir("","a","b")> yields "/a/b" and
-C<rootdir()> is "/". Note that C<rootdir()> on Mac OS is the startup
-volume, which is the closest in concept to Unix' "/". This should help
-to run existing scripts originally written for Unix.
-
-=item 8.
-
-For absolute paths, some cleanup is done, to ensure that the volume
-name isn't immediately followed by updirs. This is invalid, because
-this would go beyond "root". Generally, these cases are handled like
-their Unix counterparts:
-
- Unix:
- Unix->catdir("","") = "/"
- Unix->catdir("",".") = "/"
- Unix->catdir("","..") = "/" # can't go beyond root
- Unix->catdir("",".","..","..","a") = "/a"
- Mac:
- Mac->catdir("","") = rootdir() # (e.g. "HD:")
- Mac->catdir("",":") = rootdir()
- Mac->catdir("","::") = rootdir() # can't go beyond root
- Mac->catdir("",":","::","::","a") = rootdir() . "a:" # (e.g. "HD:a:")
-
-However, this approach is limited to the first arguments following
-"root" (again, see C<Unix-E<gt>canonpath()> ). If there are more
-arguments that move up the directory tree, an invalid path going
-beyond root can be created.
-
-=back
-
-As you've seen, you can force C<catdir()> to create an absolute path
-by passing either an empty string or a path that begins with a volume
-name as the first argument. However, you are strongly encouraged not
-to do so, since this is done only for backward compatibility. Newer
-versions of File::Spec come with a method called C<catpath()> (see
-below), that is designed to offer a portable solution for the creation
-of absolute paths. It takes volume, directory and file portions and
-returns an entire path. While C<catdir()> is still suitable for the
-concatenation of I<directory names>, you are encouraged to use
-C<catpath()> to concatenate I<volume names> and I<directory
-paths>. E.g.
-
- $dir = File::Spec->catdir("tmp","sources");
- $abs_path = File::Spec->catpath("MacintoshHD:", $dir,"");
-
-yields
-
- "MacintoshHD:tmp:sources:" .
-
-=cut
-
-sub catdir {
- my $self = shift;
- return '' unless @_;
- my @args = @_;
- my $first_arg;
- my $relative;
-
- # take care of the first argument
-
- if ($args[0] eq '') { # absolute path, rootdir
- shift @args;
- $relative = 0;
- $first_arg = $self->rootdir;
-
- } elsif ($args[0] =~ /^[^:]+:/) { # absolute path, volume name
- $relative = 0;
- $first_arg = shift @args;
- # add a trailing ':' if need be (may be it's a path like HD:dir)
- $first_arg = "$first_arg:" unless ($first_arg =~ /:\Z(?!\n)/);
-
- } else { # relative path
- $relative = 1;
- if ( $args[0] =~ /^::+\Z(?!\n)/ ) {
- # updir colon path ('::', ':::' etc.), don't shift
- $first_arg = ':';
- } elsif ($args[0] eq ':') {
- $first_arg = shift @args;
- } else {
- # add a trailing ':' if need be
- $first_arg = shift @args;
- $first_arg = "$first_arg:" unless ($first_arg =~ /:\Z(?!\n)/);
- }
- }
-
- # For all other arguments,
- # (a) ignore arguments that equal ':' or '',
- # (b) handle updir paths specially:
- # '::' -> concatenate '::'
- # '::' . '::' -> concatenate ':::' etc.
- # (c) add a trailing ':' if need be
-
- my $result = $first_arg;
- while (@args) {
- my $arg = shift @args;
- unless (($arg eq '') || ($arg eq ':')) {
- if ($arg =~ /^::+\Z(?!\n)/ ) { # updir colon path like ':::'
- my $updir_count = length($arg) - 1;
- while ((@args) && ($args[0] =~ /^::+\Z(?!\n)/) ) { # while updir colon path
- $arg = shift @args;
- $updir_count += (length($arg) - 1);
- }
- $arg = (':' x $updir_count);
- } else {
- $arg =~ s/^://s; # remove a leading ':' if any
- $arg = "$arg:" unless ($arg =~ /:\Z(?!\n)/); # ensure trailing ':'
- }
- $result .= $arg;
- }#unless
- }
-
- if ( ($relative) && ($result !~ /^:/) ) {
- # add a leading colon if need be
- $result = ":$result";
- }
-
- unless ($relative) {
- # remove updirs immediately following the volume name
- $result =~ s/([^:]+:)(:*)(.*)\Z(?!\n)/$1$3/;
- }
-
- return $result;
-}
-
-=item catfile
-
-Concatenate one or more directory names and a filename to form a
-complete path ending with a filename. Resulting paths are B<relative>
-by default, but can be forced to be absolute (but avoid this).
-
-B<IMPORTANT NOTE:> Beginning with version 1.3 of this module, the
-resulting path is relative by default and I<not> absolute. This
-decision was made due to portability reasons. Since
-C<File::Spec-E<gt>catfile()> returns relative paths on all other
-operating systems, it will now also follow this convention on Mac OS.
-Note that this may break some existing scripts.
-
-The last argument is always considered to be the file portion. Since
-C<catfile()> uses C<catdir()> (see above) for the concatenation of the
-directory portions (if any), the following with regard to relative and
-absolute paths is true:
-
- catfile("") = ""
- catfile("file") = "file"
-
-but
-
- catfile("","") = rootdir() # (e.g. "HD:")
- catfile("","file") = rootdir() . file # (e.g. "HD:file")
- catfile("HD:","file") = "HD:file"
-
-This means that C<catdir()> is called only when there are two or more
-arguments, as one might expect.
-
-Note that the leading ":" is removed from the filename, so that
-
- catfile("a","b","file") = ":a:b:file" and
-
- catfile("a","b",":file") = ":a:b:file"
-
-give the same answer.
-
-To concatenate I<volume names>, I<directory paths> and I<filenames>,
-you are encouraged to use C<catpath()> (see below).
-
-=cut
-
-sub catfile {
- my $self = shift;
- return '' unless @_;
- my $file = pop @_;
- return $file unless @_;
- my $dir = $self->catdir(@_);
- $file =~ s/^://s;
- return $dir.$file;
-}
-
-=item curdir
-
-Returns a string representing the current directory. On Mac OS, this is ":".
-
-=cut
-
-sub curdir {
- return ":";
-}
-
-=item devnull
-
-Returns a string representing the null device. On Mac OS, this is "Dev:Null".
-
-=cut
-
-sub devnull {
- return "Dev:Null";
-}
-
-=item rootdir
-
-Returns a string representing the root directory. Under MacPerl,
-returns the name of the startup volume, since that's the closest in
-concept, although other volumes aren't rooted there. The name has a
-trailing ":", because that's the correct specification for a volume
-name on Mac OS.
-
-If Mac::Files could not be loaded, the empty string is returned.
-
-=cut
-
-sub rootdir {
-#
-# There's no real root directory on Mac OS. The name of the startup
-# volume is returned, since that's the closest in concept.
-#
- return '' unless $macfiles;
- my $system = Mac::Files::FindFolder(&Mac::Files::kOnSystemDisk,
- &Mac::Files::kSystemFolderType);
- $system =~ s/:.*\Z(?!\n)/:/s;
- return $system;
-}
-
-=item tmpdir
-
-Returns the contents of $ENV{TMPDIR}, if that directory exits or the
-current working directory otherwise. Under MacPerl, $ENV{TMPDIR} will
-contain a path like "MacintoshHD:Temporary Items:", which is a hidden
-directory on your startup volume.
-
-=cut
-
-my $tmpdir;
-sub tmpdir {
- return $tmpdir if defined $tmpdir;
- $tmpdir = $_[0]->_tmpdir( $ENV{TMPDIR} );
-}
-
-=item updir
-
-Returns a string representing the parent directory. On Mac OS, this is "::".
-
-=cut
-
-sub updir {
- return "::";
-}
-
-=item file_name_is_absolute
-
-Takes as argument a path and returns true, if it is an absolute path.
-If the path has a leading ":", it's a relative path. Otherwise, it's an
-absolute path, unless the path doesn't contain any colons, i.e. it's a name
-like "a". In this particular case, the path is considered to be relative
-(i.e. it is considered to be a filename). Use ":" in the appropriate place
-in the path if you want to distinguish unambiguously. As a special case,
-the filename '' is always considered to be absolute. Note that with version
-1.2 of File::Spec::Mac, this does no longer consult the local filesystem.
-
-E.g.
-
- File::Spec->file_name_is_absolute("a"); # false (relative)
- File::Spec->file_name_is_absolute(":a:b:"); # false (relative)
- File::Spec->file_name_is_absolute("MacintoshHD:"); # true (absolute)
- File::Spec->file_name_is_absolute(""); # true (absolute)
-
-
-=cut
-
-sub file_name_is_absolute {
- my ($self,$file) = @_;
- if ($file =~ /:/) {
- return (! ($file =~ m/^:/s) );
- } elsif ( $file eq '' ) {
- return 1 ;
- } else {
- return 0; # i.e. a file like "a"
- }
-}
-
-=item path
-
-Returns the null list for the MacPerl application, since the concept is
-usually meaningless under Mac OS. But if you're using the MacPerl tool under
-MPW, it gives back $ENV{Commands} suitably split, as is done in
-:lib:ExtUtils:MM_Mac.pm.
-
-=cut
-
-sub path {
-#
-# The concept is meaningless under the MacPerl application.
-# Under MPW, it has a meaning.
-#
- return unless exists $ENV{Commands};
- return split(/,/, $ENV{Commands});
-}
-
-=item splitpath
-
- ($volume,$directories,$file) = File::Spec->splitpath( $path );
- ($volume,$directories,$file) = File::Spec->splitpath( $path, $no_file );
-
-Splits a path into volume, directory, and filename portions.
-
-On Mac OS, assumes that the last part of the path is a filename unless
-$no_file is true or a trailing separator ":" is present.
-
-The volume portion is always returned with a trailing ":". The directory portion
-is always returned with a leading (to denote a relative path) and a trailing ":"
-(to denote a directory). The file portion is always returned I<without> a leading ":".
-Empty portions are returned as empty string ''.
-
-The results can be passed to C<catpath()> to get back a path equivalent to
-(usually identical to) the original path.
-
-
-=cut
-
-sub splitpath {
- my ($self,$path, $nofile) = @_;
- my ($volume,$directory,$file);
-
- if ( $nofile ) {
- ( $volume, $directory ) = $path =~ m|^((?:[^:]+:)?)(.*)|s;
- }
- else {
- $path =~
- m|^( (?: [^:]+: )? )
- ( (?: .*: )? )
- ( .* )
- |xs;
- $volume = $1;
- $directory = $2;
- $file = $3;
- }
-
- $volume = '' unless defined($volume);
- $directory = ":$directory" if ( $volume && $directory ); # take care of "HD::dir"
- if ($directory) {
- # Make sure non-empty directories begin and end in ':'
- $directory .= ':' unless (substr($directory,-1) eq ':');
- $directory = ":$directory" unless (substr($directory,0,1) eq ':');
- } else {
- $directory = '';
- }
- $file = '' unless defined($file);
-
- return ($volume,$directory,$file);
-}
-
-
-=item splitdir
-
-The opposite of C<catdir()>.
-
- @dirs = File::Spec->splitdir( $directories );
-
-$directories should be only the directory portion of the path on systems
-that have the concept of a volume or that have path syntax that differentiates
-files from directories. Consider using C<splitpath()> otherwise.
-
-Unlike just splitting the directories on the separator, empty directory names
-(C<"">) can be returned. Since C<catdir()> on Mac OS always appends a trailing
-colon to distinguish a directory path from a file path, a single trailing colon
-will be ignored, i.e. there's no empty directory name after it.
-
-Hence, on Mac OS, both
-
- File::Spec->splitdir( ":a:b::c:" ); and
- File::Spec->splitdir( ":a:b::c" );
-
-yield:
-
- ( "a", "b", "::", "c")
-
-while
-
- File::Spec->splitdir( ":a:b::c::" );
-
-yields:
-
- ( "a", "b", "::", "c", "::")
-
-
-=cut
-
-sub splitdir {
- my ($self, $path) = @_;
- my @result = ();
- my ($head, $sep, $tail, $volume, $directories);
-
- return @result if ( (!defined($path)) || ($path eq '') );
- return (':') if ($path eq ':');
-
- ( $volume, $sep, $directories ) = $path =~ m|^((?:[^:]+:)?)(:*)(.*)|s;
-
- # deprecated, but handle it correctly
- if ($volume) {
- push (@result, $volume);
- $sep .= ':';
- }
-
- while ($sep || $directories) {
- if (length($sep) > 1) {
- my $updir_count = length($sep) - 1;
- for (my $i=0; $i<$updir_count; $i++) {
- # push '::' updir_count times;
- # simulate Unix '..' updirs
- push (@result, '::');
- }
- }
- $sep = '';
- if ($directories) {
- ( $head, $sep, $tail ) = $directories =~ m|^((?:[^:]+)?)(:*)(.*)|s;
- push (@result, $head);
- $directories = $tail;
- }
- }
- return @result;
-}
-
-
-=item catpath
-
- $path = File::Spec->catpath($volume,$directory,$file);
-
-Takes volume, directory and file portions and returns an entire path. On Mac OS,
-$volume, $directory and $file are concatenated. A ':' is inserted if need be. You
-may pass an empty string for each portion. If all portions are empty, the empty
-string is returned. If $volume is empty, the result will be a relative path,
-beginning with a ':'. If $volume and $directory are empty, a leading ":" (if any)
-is removed form $file and the remainder is returned. If $file is empty, the
-resulting path will have a trailing ':'.
-
-
-=cut
-
-sub catpath {
- my ($self,$volume,$directory,$file) = @_;
-
- if ( (! $volume) && (! $directory) ) {
- $file =~ s/^:// if $file;
- return $file ;
- }
-
- # We look for a volume in $volume, then in $directory, but not both
-
- my ($dir_volume, $dir_dirs) = $self->splitpath($directory, 1);
-
- $volume = $dir_volume unless length $volume;
- my $path = $volume; # may be ''
- $path .= ':' unless (substr($path, -1) eq ':'); # ensure trailing ':'
-
- if ($directory) {
- $directory = $dir_dirs if $volume;
- $directory =~ s/^://; # remove leading ':' if any
- $path .= $directory;
- $path .= ':' unless (substr($path, -1) eq ':'); # ensure trailing ':'
- }
-
- if ($file) {
- $file =~ s/^://; # remove leading ':' if any
- $path .= $file;
- }
-
- return $path;
-}
-
-=item abs2rel
-
-Takes a destination path and an optional base path and returns a relative path
-from the base path to the destination path:
-
- $rel_path = File::Spec->abs2rel( $path ) ;
- $rel_path = File::Spec->abs2rel( $path, $base ) ;
-
-Note that both paths are assumed to have a notation that distinguishes a
-directory path (with trailing ':') from a file path (without trailing ':').
-
-If $base is not present or '', then the current working directory is used.
-If $base is relative, then it is converted to absolute form using C<rel2abs()>.
-This means that it is taken to be relative to the current working directory.
-
-If $path and $base appear to be on two different volumes, we will not
-attempt to resolve the two paths, and we will instead simply return
-$path. Note that previous versions of this module ignored the volume
-of $base, which resulted in garbage results part of the time.
-
-If $base doesn't have a trailing colon, the last element of $base is
-assumed to be a filename. This filename is ignored. Otherwise all path
-components are assumed to be directories.
-
-If $path is relative, it is converted to absolute form using C<rel2abs()>.
-This means that it is taken to be relative to the current working directory.
-
-Based on code written by Shigio Yamaguchi.
-
-
-=cut
-
-# maybe this should be done in canonpath() ?
-sub _resolve_updirs {
- my $path = shift @_;
- my $proceed;
-
- # resolve any updirs, e.g. "HD:tmp::file" -> "HD:file"
- do {
- $proceed = ($path =~ s/^(.*):[^:]+::(.*?)\z/$1:$2/);
- } while ($proceed);
-
- return $path;
-}
-
-
-sub abs2rel {
- my($self,$path,$base) = @_;
-
- # Clean up $path
- if ( ! $self->file_name_is_absolute( $path ) ) {
- $path = $self->rel2abs( $path ) ;
- }
-
- # Figure out the effective $base and clean it up.
- if ( !defined( $base ) || $base eq '' ) {
- $base = $self->_cwd();
- }
- elsif ( ! $self->file_name_is_absolute( $base ) ) {
- $base = $self->rel2abs( $base ) ;
- $base = _resolve_updirs( $base ); # resolve updirs in $base
- }
- else {
- $base = _resolve_updirs( $base );
- }
-
- # Split up paths - ignore $base's file
- my ( $path_vol, $path_dirs, $path_file ) = $self->splitpath( $path );
- my ( $base_vol, $base_dirs ) = $self->splitpath( $base );
-
- return $path unless lc( $path_vol ) eq lc( $base_vol );
-
- # Now, remove all leading components that are the same
- my @pathchunks = $self->splitdir( $path_dirs );
- my @basechunks = $self->splitdir( $base_dirs );
-
- while ( @pathchunks &&
- @basechunks &&
- lc( $pathchunks[0] ) eq lc( $basechunks[0] ) ) {
- shift @pathchunks ;
- shift @basechunks ;
- }
-
- # @pathchunks now has the directories to descend in to.
- # ensure relative path, even if @pathchunks is empty
- $path_dirs = $self->catdir( ':', @pathchunks );
-
- # @basechunks now contains the number of directories to climb out of.
- $base_dirs = (':' x @basechunks) . ':' ;
-
- return $self->catpath( '', $self->catdir( $base_dirs, $path_dirs ), $path_file ) ;
-}
-
-=item rel2abs
-
-Converts a relative path to an absolute path:
-
- $abs_path = File::Spec->rel2abs( $path ) ;
- $abs_path = File::Spec->rel2abs( $path, $base ) ;
-
-Note that both paths are assumed to have a notation that distinguishes a
-directory path (with trailing ':') from a file path (without trailing ':').
-
-If $base is not present or '', then $base is set to the current working
-directory. If $base is relative, then it is converted to absolute form
-using C<rel2abs()>. This means that it is taken to be relative to the
-current working directory.
-
-If $base doesn't have a trailing colon, the last element of $base is
-assumed to be a filename. This filename is ignored. Otherwise all path
-components are assumed to be directories.
-
-If $path is already absolute, it is returned and $base is ignored.
-
-Based on code written by Shigio Yamaguchi.
-
-=cut
-
-sub rel2abs {
- my ($self,$path,$base) = @_;
-
- if ( ! $self->file_name_is_absolute($path) ) {
- # Figure out the effective $base and clean it up.
- if ( !defined( $base ) || $base eq '' ) {
- $base = $self->_cwd();
- }
- elsif ( ! $self->file_name_is_absolute($base) ) {
- $base = $self->rel2abs($base) ;
- }
-
- # Split up paths
-
- # igonore $path's volume
- my ( $path_dirs, $path_file ) = ($self->splitpath($path))[1,2] ;
-
- # ignore $base's file part
- my ( $base_vol, $base_dirs ) = $self->splitpath($base) ;
-
- # Glom them together
- $path_dirs = ':' if ($path_dirs eq '');
- $base_dirs =~ s/:$//; # remove trailing ':', if any
- $base_dirs = $base_dirs . $path_dirs;
-
- $path = $self->catpath( $base_vol, $base_dirs, $path_file );
- }
- return $path;
-}
-
-
-=back
-
-=head1 AUTHORS
-
-See the authors list in I<File::Spec>. Mac OS support by Paul Schinder
-<schinder@pobox.com> and Thomas Wegner <wegner_thomas@yahoo.com>.
-
-=head1 COPYRIGHT
-
-Copyright (c) 2004 by the Perl 5 Porters. 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
-
-See L<File::Spec> and L<File::Spec::Unix>. This package overrides the
-implementation of these methods, not the semantics.
-
-=cut
-
-1;
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/File/Spec/OS2.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/File/Spec/OS2.pm
deleted file mode 100644
index 48d09fa2f9c..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/File/Spec/OS2.pm
+++ /dev/null
@@ -1,273 +0,0 @@
-package File::Spec::OS2;
-
-use strict;
-use vars qw(@ISA $VERSION);
-require File::Spec::Unix;
-
-$VERSION = '3.2701';
-
-@ISA = qw(File::Spec::Unix);
-
-sub devnull {
- return "/dev/nul";
-}
-
-sub case_tolerant {
- return 1;
-}
-
-sub file_name_is_absolute {
- my ($self,$file) = @_;
- return scalar($file =~ m{^([a-z]:)?[\\/]}is);
-}
-
-sub path {
- my $path = $ENV{PATH};
- $path =~ s:\\:/:g;
- my @path = split(';',$path);
- foreach (@path) { $_ = '.' if $_ eq '' }
- return @path;
-}
-
-sub _cwd {
- # In OS/2 the "require Cwd" is unnecessary bloat.
- return Cwd::sys_cwd();
-}
-
-my $tmpdir;
-sub tmpdir {
- return $tmpdir if defined $tmpdir;
- my @d = @ENV{qw(TMPDIR TEMP TMP)}; # function call could autovivivy
- $tmpdir = $_[0]->_tmpdir( @d, '/tmp', '/' );
-}
-
-sub catdir {
- my $self = shift;
- my @args = @_;
- foreach (@args) {
- tr[\\][/];
- # append a backslash to each argument unless it has one there
- $_ .= "/" unless m{/$};
- }
- return $self->canonpath(join('', @args));
-}
-
-sub canonpath {
- my ($self,$path) = @_;
- return unless defined $path;
-
- $path =~ s/^([a-z]:)/\l$1/s;
- $path =~ s|\\|/|g;
- $path =~ s|([^/])/+|$1/|g; # xx////xx -> xx/xx
- $path =~ s|(/\.)+/|/|g; # xx/././xx -> xx/xx
- $path =~ s|^(\./)+(?=[^/])||s; # ./xx -> xx
- $path =~ s|/\Z(?!\n)||
- unless $path =~ m#^([a-z]:)?/\Z(?!\n)#si;# xx/ -> xx
- $path =~ s{^/\.\.$}{/}; # /.. -> /
- 1 while $path =~ s{^/\.\.}{}; # /../xx -> /xx
- return $path;
-}
-
-
-sub splitpath {
- my ($self,$path, $nofile) = @_;
- my ($volume,$directory,$file) = ('','','');
- if ( $nofile ) {
- $path =~
- m{^( (?:[a-zA-Z]:|(?:\\\\|//)[^\\/]+[\\/][^\\/]+)? )
- (.*)
- }xs;
- $volume = $1;
- $directory = $2;
- }
- else {
- $path =~
- m{^ ( (?: [a-zA-Z]: |
- (?:\\\\|//)[^\\/]+[\\/][^\\/]+
- )?
- )
- ( (?:.*[\\\\/](?:\.\.?\Z(?!\n))?)? )
- (.*)
- }xs;
- $volume = $1;
- $directory = $2;
- $file = $3;
- }
-
- return ($volume,$directory,$file);
-}
-
-
-sub splitdir {
- my ($self,$directories) = @_ ;
- split m|[\\/]|, $directories, -1;
-}
-
-
-sub catpath {
- my ($self,$volume,$directory,$file) = @_;
-
- # If it's UNC, make sure the glue separator is there, reusing
- # whatever separator is first in the $volume
- $volume .= $1
- if ( $volume =~ m@^([\\/])[\\/][^\\/]+[\\/][^\\/]+\Z(?!\n)@s &&
- $directory =~ m@^[^\\/]@s
- ) ;
-
- $volume .= $directory ;
-
- # If the volume is not just A:, make sure the glue separator is
- # there, reusing whatever separator is first in the $volume if possible.
- if ( $volume !~ m@^[a-zA-Z]:\Z(?!\n)@s &&
- $volume =~ m@[^\\/]\Z(?!\n)@ &&
- $file =~ m@[^\\/]@
- ) {
- $volume =~ m@([\\/])@ ;
- my $sep = $1 ? $1 : '/' ;
- $volume .= $sep ;
- }
-
- $volume .= $file ;
-
- return $volume ;
-}
-
-
-sub abs2rel {
- my($self,$path,$base) = @_;
-
- # Clean up $path
- if ( ! $self->file_name_is_absolute( $path ) ) {
- $path = $self->rel2abs( $path ) ;
- } else {
- $path = $self->canonpath( $path ) ;
- }
-
- # Figure out the effective $base and clean it up.
- if ( !defined( $base ) || $base eq '' ) {
- $base = $self->_cwd();
- } elsif ( ! $self->file_name_is_absolute( $base ) ) {
- $base = $self->rel2abs( $base ) ;
- } else {
- $base = $self->canonpath( $base ) ;
- }
-
- # Split up paths
- my ( $path_volume, $path_directories, $path_file ) = $self->splitpath( $path, 1 ) ;
- my ( $base_volume, $base_directories ) = $self->splitpath( $base, 1 ) ;
- return $path unless $path_volume eq $base_volume;
-
- # Now, remove all leading components that are the same
- my @pathchunks = $self->splitdir( $path_directories );
- my @basechunks = $self->splitdir( $base_directories );
-
- while ( @pathchunks &&
- @basechunks &&
- lc( $pathchunks[0] ) eq lc( $basechunks[0] )
- ) {
- shift @pathchunks ;
- shift @basechunks ;
- }
-
- # No need to catdir, we know these are well formed.
- $path_directories = CORE::join( '/', @pathchunks );
- $base_directories = CORE::join( '/', @basechunks );
-
- # $base_directories now contains the directories the resulting relative
- # path must ascend out of before it can descend to $path_directory. So,
- # replace all names with $parentDir
-
- #FA Need to replace between backslashes...
- $base_directories =~ s|[^\\/]+|..|g ;
-
- # Glue the two together, using a separator if necessary, and preventing an
- # empty result.
-
- #FA Must check that new directories are not empty.
- if ( $path_directories ne '' && $base_directories ne '' ) {
- $path_directories = "$base_directories/$path_directories" ;
- } else {
- $path_directories = "$base_directories$path_directories" ;
- }
-
- return $self->canonpath(
- $self->catpath( "", $path_directories, $path_file )
- ) ;
-}
-
-
-sub rel2abs {
- my ($self,$path,$base ) = @_;
-
- if ( ! $self->file_name_is_absolute( $path ) ) {
-
- if ( !defined( $base ) || $base eq '' ) {
- $base = $self->_cwd();
- }
- elsif ( ! $self->file_name_is_absolute( $base ) ) {
- $base = $self->rel2abs( $base ) ;
- }
- else {
- $base = $self->canonpath( $base ) ;
- }
-
- my ( $path_directories, $path_file ) =
- ($self->splitpath( $path, 1 ))[1,2] ;
-
- my ( $base_volume, $base_directories ) =
- $self->splitpath( $base, 1 ) ;
-
- $path = $self->catpath(
- $base_volume,
- $self->catdir( $base_directories, $path_directories ),
- $path_file
- ) ;
- }
-
- return $self->canonpath( $path ) ;
-}
-
-1;
-__END__
-
-=head1 NAME
-
-File::Spec::OS2 - methods for OS/2 file specs
-
-=head1 SYNOPSIS
-
- require File::Spec::OS2; # Done internally by File::Spec if needed
-
-=head1 DESCRIPTION
-
-See L<File::Spec> and L<File::Spec::Unix>. This package overrides the
-implementation of these methods, not the semantics.
-
-Amongst the changes made for OS/2 are...
-
-=over 4
-
-=item tmpdir
-
-Modifies the list of places temp directory information is looked for.
-
- $ENV{TMPDIR}
- $ENV{TEMP}
- $ENV{TMP}
- /tmp
- /
-
-=item splitpath
-
-Volumes can be drive letters or UNC sharenames (\\server\share).
-
-=back
-
-=head1 COPYRIGHT
-
-Copyright (c) 2004 by the Perl 5 Porters. 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/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/File/Spec/Unix.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/File/Spec/Unix.pm
deleted file mode 100644
index e8dbaa93328..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/File/Spec/Unix.pm
+++ /dev/null
@@ -1,517 +0,0 @@
-package File::Spec::Unix;
-
-use strict;
-use vars qw($VERSION);
-
-$VERSION = '3.2701';
-
-=head1 NAME
-
-File::Spec::Unix - File::Spec for Unix, base for other File::Spec modules
-
-=head1 SYNOPSIS
-
- require File::Spec::Unix; # Done automatically by File::Spec
-
-=head1 DESCRIPTION
-
-Methods for manipulating file specifications. Other File::Spec
-modules, such as File::Spec::Mac, inherit from File::Spec::Unix and
-override specific methods.
-
-=head1 METHODS
-
-=over 2
-
-=item canonpath()
-
-No physical check on the filesystem, but a logical cleanup of a
-path. On UNIX eliminates successive slashes and successive "/.".
-
- $cpath = File::Spec->canonpath( $path ) ;
-
-Note that this does *not* collapse F<x/../y> sections into F<y>. This
-is by design. If F</foo> on your system is a symlink to F</bar/baz>,
-then F</foo/../quux> is actually F</bar/quux>, not F</quux> as a naive
-F<../>-removal would give you. If you want to do this kind of
-processing, you probably want C<Cwd>'s C<realpath()> function to
-actually traverse the filesystem cleaning up paths like this.
-
-=cut
-
-sub canonpath {
- my ($self,$path) = @_;
- return unless defined $path;
-
- # Handle POSIX-style node names beginning with double slash (qnx, nto)
- # (POSIX says: "a pathname that begins with two successive slashes
- # may be interpreted in an implementation-defined manner, although
- # more than two leading slashes shall be treated as a single slash.")
- my $node = '';
- my $double_slashes_special = $^O eq 'qnx' || $^O eq 'nto';
- if ( $double_slashes_special && $path =~ s{^(//[^/]+)(?:/|\z)}{/}s ) {
- $node = $1;
- }
- # This used to be
- # $path =~ s|/+|/|g unless ($^O eq 'cygwin');
- # but that made tests 29, 30, 35, 46, and 213 (as of #13272) to fail
- # (Mainly because trailing "" directories didn't get stripped).
- # Why would cygwin avoid collapsing multiple slashes into one? --jhi
- $path =~ s|/{2,}|/|g; # xx////xx -> xx/xx
- $path =~ s{(?:/\.)+(?:/|\z)}{/}g; # xx/././xx -> xx/xx
- $path =~ s|^(?:\./)+||s unless $path eq "./"; # ./xx -> xx
- $path =~ s|^/(?:\.\./)+|/|; # /../../xx -> xx
- $path =~ s|^/\.\.$|/|; # /.. -> /
- $path =~ s|/\z|| unless $path eq "/"; # xx/ -> xx
- return "$node$path";
-}
-
-=item catdir()
-
-Concatenate two or more directory names to form a complete path ending
-with a directory. But remove the trailing slash from the resulting
-string, because it doesn't look good, isn't necessary and confuses
-OS2. Of course, if this is the root directory, don't cut off the
-trailing slash :-)
-
-=cut
-
-sub catdir {
- my $self = shift;
-
- $self->canonpath(join('/', @_, '')); # '' because need a trailing '/'
-}
-
-=item catfile
-
-Concatenate one or more directory names and a filename to form a
-complete path ending with a filename
-
-=cut
-
-sub catfile {
- my $self = shift;
- my $file = $self->canonpath(pop @_);
- return $file unless @_;
- my $dir = $self->catdir(@_);
- $dir .= "/" unless substr($dir,-1) eq "/";
- return $dir.$file;
-}
-
-=item curdir
-
-Returns a string representation of the current directory. "." on UNIX.
-
-=cut
-
-sub curdir () { '.' }
-
-=item devnull
-
-Returns a string representation of the null device. "/dev/null" on UNIX.
-
-=cut
-
-sub devnull () { '/dev/null' }
-
-=item rootdir
-
-Returns a string representation of the root directory. "/" on UNIX.
-
-=cut
-
-sub rootdir () { '/' }
-
-=item tmpdir
-
-Returns a string representation of the first writable directory from
-the following list or the current directory if none from the list are
-writable:
-
- $ENV{TMPDIR}
- /tmp
-
-Since perl 5.8.0, if running under taint mode, and if $ENV{TMPDIR}
-is tainted, it is not used.
-
-=cut
-
-my $tmpdir;
-sub _tmpdir {
- return $tmpdir if defined $tmpdir;
- my $self = shift;
- my @dirlist = @_;
- {
- no strict 'refs';
- if (${"\cTAINT"}) { # Check for taint mode on perl >= 5.8.0
- require Scalar::Util;
- @dirlist = grep { ! Scalar::Util::tainted($_) } @dirlist;
- }
- }
- foreach (@dirlist) {
- next unless defined && -d && -w _;
- $tmpdir = $_;
- last;
- }
- $tmpdir = $self->curdir unless defined $tmpdir;
- $tmpdir = defined $tmpdir && $self->canonpath($tmpdir);
- return $tmpdir;
-}
-
-sub tmpdir {
- return $tmpdir if defined $tmpdir;
- $tmpdir = $_[0]->_tmpdir( $ENV{TMPDIR}, "/tmp" );
-}
-
-=item updir
-
-Returns a string representation of the parent directory. ".." on UNIX.
-
-=cut
-
-sub updir () { '..' }
-
-=item no_upwards
-
-Given a list of file names, strip out those that refer to a parent
-directory. (Does not strip symlinks, only '.', '..', and equivalents.)
-
-=cut
-
-sub no_upwards {
- my $self = shift;
- return grep(!/^\.{1,2}\z/s, @_);
-}
-
-=item case_tolerant
-
-Returns a true or false value indicating, respectively, that alphabetic
-is not or is significant when comparing file specifications.
-
-=cut
-
-sub case_tolerant () { 0 }
-
-=item file_name_is_absolute
-
-Takes as argument a path and returns true if it is an absolute path.
-
-This does not consult the local filesystem on Unix, Win32, OS/2 or Mac
-OS (Classic). It does consult the working environment for VMS (see
-L<File::Spec::VMS/file_name_is_absolute>).
-
-=cut
-
-sub file_name_is_absolute {
- my ($self,$file) = @_;
- return scalar($file =~ m:^/:s);
-}
-
-=item path
-
-Takes no argument, returns the environment variable PATH as an array.
-
-=cut
-
-sub path {
- return () unless exists $ENV{PATH};
- my @path = split(':', $ENV{PATH});
- foreach (@path) { $_ = '.' if $_ eq '' }
- return @path;
-}
-
-=item join
-
-join is the same as catfile.
-
-=cut
-
-sub join {
- my $self = shift;
- return $self->catfile(@_);
-}
-
-=item splitpath
-
- ($volume,$directories,$file) = File::Spec->splitpath( $path );
- ($volume,$directories,$file) = File::Spec->splitpath( $path, $no_file );
-
-Splits a path into volume, directory, and filename portions. On systems
-with no concept of volume, returns '' for volume.
-
-For systems with no syntax differentiating filenames from directories,
-assumes that the last file is a path unless $no_file is true or a
-trailing separator or /. or /.. is present. On Unix this means that $no_file
-true makes this return ( '', $path, '' ).
-
-The directory portion may or may not be returned with a trailing '/'.
-
-The results can be passed to L</catpath()> to get back a path equivalent to
-(usually identical to) the original path.
-
-=cut
-
-sub splitpath {
- my ($self,$path, $nofile) = @_;
-
- my ($volume,$directory,$file) = ('','','');
-
- if ( $nofile ) {
- $directory = $path;
- }
- else {
- $path =~ m|^ ( (?: .* / (?: \.\.?\z )? )? ) ([^/]*) |xs;
- $directory = $1;
- $file = $2;
- }
-
- return ($volume,$directory,$file);
-}
-
-
-=item splitdir
-
-The opposite of L</catdir()>.
-
- @dirs = File::Spec->splitdir( $directories );
-
-$directories must be only the directory portion of the path on systems
-that have the concept of a volume or that have path syntax that differentiates
-files from directories.
-
-Unlike just splitting the directories on the separator, empty
-directory names (C<''>) can be returned, because these are significant
-on some OSs.
-
-On Unix,
-
- File::Spec->splitdir( "/a/b//c/" );
-
-Yields:
-
- ( '', 'a', 'b', '', 'c', '' )
-
-=cut
-
-sub splitdir {
- return split m|/|, $_[1], -1; # Preserve trailing fields
-}
-
-
-=item catpath()
-
-Takes volume, directory and file portions and returns an entire path. Under
-Unix, $volume is ignored, and directory and file are concatenated. A '/' is
-inserted if needed (though if the directory portion doesn't start with
-'/' it is not added). On other OSs, $volume is significant.
-
-=cut
-
-sub catpath {
- my ($self,$volume,$directory,$file) = @_;
-
- if ( $directory ne '' &&
- $file ne '' &&
- substr( $directory, -1 ) ne '/' &&
- substr( $file, 0, 1 ) ne '/'
- ) {
- $directory .= "/$file" ;
- }
- else {
- $directory .= $file ;
- }
-
- return $directory ;
-}
-
-=item abs2rel
-
-Takes a destination path and an optional base path returns a relative path
-from the base path to the destination path:
-
- $rel_path = File::Spec->abs2rel( $path ) ;
- $rel_path = File::Spec->abs2rel( $path, $base ) ;
-
-If $base is not present or '', then L<cwd()|Cwd> is used. If $base is
-relative, then it is converted to absolute form using
-L</rel2abs()>. This means that it is taken to be relative to
-L<cwd()|Cwd>.
-
-On systems that have a grammar that indicates filenames, this ignores the
-$base filename. Otherwise all path components are assumed to be
-directories.
-
-If $path is relative, it is converted to absolute form using L</rel2abs()>.
-This means that it is taken to be relative to L<cwd()|Cwd>.
-
-No checks against the filesystem are made. On VMS, there is
-interaction with the working environment, as logicals and
-macros are expanded.
-
-Based on code written by Shigio Yamaguchi.
-
-=cut
-
-sub abs2rel {
- my($self,$path,$base) = @_;
- $base = $self->_cwd() unless defined $base and length $base;
-
- ($path, $base) = map $self->canonpath($_), $path, $base;
-
- if (grep $self->file_name_is_absolute($_), $path, $base) {
- ($path, $base) = map $self->rel2abs($_), $path, $base;
- }
- else {
- # save a couple of cwd()s if both paths are relative
- ($path, $base) = map $self->catdir('/', $_), $path, $base;
- }
-
- my ($path_volume) = $self->splitpath($path, 1);
- my ($base_volume) = $self->splitpath($base, 1);
-
- # Can't relativize across volumes
- return $path unless $path_volume eq $base_volume;
-
- my $path_directories = ($self->splitpath($path, 1))[1];
- my $base_directories = ($self->splitpath($base, 1))[1];
-
- # For UNC paths, the user might give a volume like //foo/bar that
- # strictly speaking has no directory portion. Treat it as if it
- # had the root directory for that volume.
- if (!length($base_directories) and $self->file_name_is_absolute($base)) {
- $base_directories = $self->rootdir;
- }
-
- # Now, remove all leading components that are the same
- my @pathchunks = $self->splitdir( $path_directories );
- my @basechunks = $self->splitdir( $base_directories );
-
- if ($base_directories eq $self->rootdir) {
- shift @pathchunks;
- return $self->canonpath( $self->catpath('', $self->catdir( @pathchunks ), '') );
- }
-
- while (@pathchunks && @basechunks && $self->_same($pathchunks[0], $basechunks[0])) {
- shift @pathchunks ;
- shift @basechunks ;
- }
- return $self->curdir unless @pathchunks || @basechunks;
-
- # $base now contains the directories the resulting relative path
- # must ascend out of before it can descend to $path_directory.
- my $result_dirs = $self->catdir( ($self->updir) x @basechunks, @pathchunks );
- return $self->canonpath( $self->catpath('', $result_dirs, '') );
-}
-
-sub _same {
- $_[1] eq $_[2];
-}
-
-=item rel2abs()
-
-Converts a relative path to an absolute path.
-
- $abs_path = File::Spec->rel2abs( $path ) ;
- $abs_path = File::Spec->rel2abs( $path, $base ) ;
-
-If $base is not present or '', then L<cwd()|Cwd> is used. If $base is
-relative, then it is converted to absolute form using
-L</rel2abs()>. This means that it is taken to be relative to
-L<cwd()|Cwd>.
-
-On systems that have a grammar that indicates filenames, this ignores
-the $base filename. Otherwise all path components are assumed to be
-directories.
-
-If $path is absolute, it is cleaned up and returned using L</canonpath()>.
-
-No checks against the filesystem are made. On VMS, there is
-interaction with the working environment, as logicals and
-macros are expanded.
-
-Based on code written by Shigio Yamaguchi.
-
-=cut
-
-sub rel2abs {
- my ($self,$path,$base ) = @_;
-
- # Clean up $path
- if ( ! $self->file_name_is_absolute( $path ) ) {
- # Figure out the effective $base and clean it up.
- if ( !defined( $base ) || $base eq '' ) {
- $base = $self->_cwd();
- }
- elsif ( ! $self->file_name_is_absolute( $base ) ) {
- $base = $self->rel2abs( $base ) ;
- }
- else {
- $base = $self->canonpath( $base ) ;
- }
-
- # Glom them together
- $path = $self->catdir( $base, $path ) ;
- }
-
- return $self->canonpath( $path ) ;
-}
-
-=back
-
-=head1 COPYRIGHT
-
-Copyright (c) 2004 by the Perl 5 Porters. 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<File::Spec>
-
-=cut
-
-# Internal routine to File::Spec, no point in making this public since
-# it is the standard Cwd interface. Most of the platform-specific
-# File::Spec subclasses use this.
-sub _cwd {
- require Cwd;
- Cwd::getcwd();
-}
-
-
-# Internal method to reduce xx\..\yy -> yy
-sub _collapse {
- my($fs, $path) = @_;
-
- my $updir = $fs->updir;
- my $curdir = $fs->curdir;
-
- my($vol, $dirs, $file) = $fs->splitpath($path);
- my @dirs = $fs->splitdir($dirs);
- pop @dirs if @dirs && $dirs[-1] eq '';
-
- my @collapsed;
- foreach my $dir (@dirs) {
- if( $dir eq $updir and # if we have an updir
- @collapsed and # and something to collapse
- length $collapsed[-1] and # and its not the rootdir
- $collapsed[-1] ne $updir and # nor another updir
- $collapsed[-1] ne $curdir # nor the curdir
- )
- { # then
- pop @collapsed; # collapse
- }
- else { # else
- push @collapsed, $dir; # just hang onto it
- }
- }
-
- return $fs->catpath($vol,
- $fs->catdir(@collapsed),
- $file
- );
-}
-
-
-1;
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/File/Spec/VMS.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/File/Spec/VMS.pm
deleted file mode 100644
index 747a89d4fdb..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/File/Spec/VMS.pm
+++ /dev/null
@@ -1,536 +0,0 @@
-package File::Spec::VMS;
-
-use strict;
-use vars qw(@ISA $VERSION);
-require File::Spec::Unix;
-
-$VERSION = '3.2701';
-
-@ISA = qw(File::Spec::Unix);
-
-use File::Basename;
-use VMS::Filespec;
-
-=head1 NAME
-
-File::Spec::VMS - methods for VMS file specs
-
-=head1 SYNOPSIS
-
- require File::Spec::VMS; # Done internally by File::Spec if needed
-
-=head1 DESCRIPTION
-
-See File::Spec::Unix for a documentation of the methods provided
-there. This package overrides the implementation of these methods, not
-the semantics.
-
-=over 4
-
-=item canonpath (override)
-
-Removes redundant portions of file specifications according to VMS syntax.
-
-=cut
-
-sub canonpath {
- my($self,$path) = @_;
-
- return undef unless defined $path;
-
- if ($path =~ m|/|) { # Fake Unix
- my $pathify = $path =~ m|/\Z(?!\n)|;
- $path = $self->SUPER::canonpath($path);
- if ($pathify) { return vmspath($path); }
- else { return vmsify($path); }
- }
- else {
- $path =~ tr/<>/[]/; # < and > ==> [ and ]
- $path =~ s/\]\[\./\.\]\[/g; # ][. ==> .][
- $path =~ s/\[000000\.\]\[/\[/g; # [000000.][ ==> [
- $path =~ s/\[000000\./\[/g; # [000000. ==> [
- $path =~ s/\.\]\[000000\]/\]/g; # .][000000] ==> ]
- $path =~ s/\.\]\[/\./g; # foo.][bar ==> foo.bar
- 1 while ($path =~ s/([\[\.])(-+)\.(-+)([\.\]])/$1$2$3$4/);
- # That loop does the following
- # with any amount of dashes:
- # .-.-. ==> .--.
- # [-.-. ==> [--.
- # .-.-] ==> .--]
- # [-.-] ==> [--]
- 1 while ($path =~ s/([\[\.])[^\]\.]+\.-(-+)([\]\.])/$1$2$3/);
- # That loop does the following
- # with any amount (minimum 2)
- # of dashes:
- # .foo.--. ==> .-.
- # .foo.--] ==> .-]
- # [foo.--. ==> [-.
- # [foo.--] ==> [-]
- #
- # And then, the remaining cases
- $path =~ s/\[\.-/[-/; # [.- ==> [-
- $path =~ s/\.[^\]\.]+\.-\./\./g; # .foo.-. ==> .
- $path =~ s/\[[^\]\.]+\.-\./\[/g; # [foo.-. ==> [
- $path =~ s/\.[^\]\.]+\.-\]/\]/g; # .foo.-] ==> ]
- $path =~ s/\[[^\]\.]+\.-\]/\[000000\]/g;# [foo.-] ==> [000000]
- $path =~ s/\[\]// unless $path eq '[]'; # [] ==>
- return $path;
- }
-}
-
-=item catdir (override)
-
-Concatenates a list of file specifications, and returns the result as a
-VMS-syntax directory specification. No check is made for "impossible"
-cases (e.g. elements other than the first being absolute filespecs).
-
-=cut
-
-sub catdir {
- my $self = shift;
- my $dir = pop;
- my @dirs = grep {defined() && length()} @_;
-
- my $rslt;
- if (@dirs) {
- my $path = (@dirs == 1 ? $dirs[0] : $self->catdir(@dirs));
- my ($spath,$sdir) = ($path,$dir);
- $spath =~ s/\.dir\Z(?!\n)//; $sdir =~ s/\.dir\Z(?!\n)//;
- $sdir = $self->eliminate_macros($sdir) unless $sdir =~ /^[\w\-]+\Z(?!\n)/s;
- $rslt = $self->fixpath($self->eliminate_macros($spath)."/$sdir",1);
-
- # Special case for VMS absolute directory specs: these will have had device
- # prepended during trip through Unix syntax in eliminate_macros(), since
- # Unix syntax has no way to express "absolute from the top of this device's
- # directory tree".
- if ($spath =~ /^[\[<][^.\-]/s) { $rslt =~ s/^[^\[<]+//s; }
- }
- else {
- if (not defined $dir or not length $dir) { $rslt = ''; }
- elsif ($dir =~ /^\$\([^\)]+\)\Z(?!\n)/s) { $rslt = $dir; }
- else { $rslt = vmspath($dir); }
- }
- return $self->canonpath($rslt);
-}
-
-=item catfile (override)
-
-Concatenates a list of file specifications, and returns the result as a
-VMS-syntax file specification.
-
-=cut
-
-sub catfile {
- my $self = shift;
- my $file = $self->canonpath(pop());
- my @files = grep {defined() && length()} @_;
-
- my $rslt;
- if (@files) {
- my $path = (@files == 1 ? $files[0] : $self->catdir(@files));
- my $spath = $path;
- $spath =~ s/\.dir\Z(?!\n)//;
- if ($spath =~ /^[^\)\]\/:>]+\)\Z(?!\n)/s && basename($file) eq $file) {
- $rslt = "$spath$file";
- }
- else {
- $rslt = $self->eliminate_macros($spath);
- $rslt = vmsify($rslt.((defined $rslt) && ($rslt ne '') ? '/' : '').unixify($file));
- }
- }
- else { $rslt = (defined($file) && length($file)) ? vmsify($file) : ''; }
- return $self->canonpath($rslt);
-}
-
-
-=item curdir (override)
-
-Returns a string representation of the current directory: '[]'
-
-=cut
-
-sub curdir {
- return '[]';
-}
-
-=item devnull (override)
-
-Returns a string representation of the null device: '_NLA0:'
-
-=cut
-
-sub devnull {
- return "_NLA0:";
-}
-
-=item rootdir (override)
-
-Returns a string representation of the root directory: 'SYS$DISK:[000000]'
-
-=cut
-
-sub rootdir {
- return 'SYS$DISK:[000000]';
-}
-
-=item tmpdir (override)
-
-Returns a string representation of the first writable directory
-from the following list or '' if none are writable:
-
- sys$scratch:
- $ENV{TMPDIR}
-
-Since perl 5.8.0, if running under taint mode, and if $ENV{TMPDIR}
-is tainted, it is not used.
-
-=cut
-
-my $tmpdir;
-sub tmpdir {
- return $tmpdir if defined $tmpdir;
- $tmpdir = $_[0]->_tmpdir( 'sys$scratch:', $ENV{TMPDIR} );
-}
-
-=item updir (override)
-
-Returns a string representation of the parent directory: '[-]'
-
-=cut
-
-sub updir {
- return '[-]';
-}
-
-=item case_tolerant (override)
-
-VMS file specification syntax is case-tolerant.
-
-=cut
-
-sub case_tolerant {
- return 1;
-}
-
-=item path (override)
-
-Translate logical name DCL$PATH as a searchlist, rather than trying
-to C<split> string value of C<$ENV{'PATH'}>.
-
-=cut
-
-sub path {
- my (@dirs,$dir,$i);
- while ($dir = $ENV{'DCL$PATH;' . $i++}) { push(@dirs,$dir); }
- return @dirs;
-}
-
-=item file_name_is_absolute (override)
-
-Checks for VMS directory spec as well as Unix separators.
-
-=cut
-
-sub file_name_is_absolute {
- my ($self,$file) = @_;
- # If it's a logical name, expand it.
- $file = $ENV{$file} while $file =~ /^[\w\$\-]+\Z(?!\n)/s && $ENV{$file};
- return scalar($file =~ m!^/!s ||
- $file =~ m![<\[][^.\-\]>]! ||
- $file =~ /:[^<\[]/);
-}
-
-=item splitpath (override)
-
-Splits using VMS syntax.
-
-=cut
-
-sub splitpath {
- my($self,$path) = @_;
- my($dev,$dir,$file) = ('','','');
-
- vmsify($path) =~ /(.+:)?([\[<].*[\]>])?(.*)/s;
- return ($1 || '',$2 || '',$3);
-}
-
-=item splitdir (override)
-
-Split dirspec using VMS syntax.
-
-=cut
-
-sub splitdir {
- my($self,$dirspec) = @_;
- my @dirs = ();
- return @dirs if ( (!defined $dirspec) || ('' eq $dirspec) );
- $dirspec =~ tr/<>/[]/; # < and > ==> [ and ]
- $dirspec =~ s/\]\[\./\.\]\[/g; # ][. ==> .][
- $dirspec =~ s/\[000000\.\]\[/\[/g; # [000000.][ ==> [
- $dirspec =~ s/\[000000\./\[/g; # [000000. ==> [
- $dirspec =~ s/\.\]\[000000\]/\]/g; # .][000000] ==> ]
- $dirspec =~ s/\.\]\[/\./g; # foo.][bar ==> foo.bar
- while ($dirspec =~ s/(^|[\[\<\.])\-(\-+)($|[\]\>\.])/$1-.$2$3/g) {}
- # That loop does the following
- # with any amount of dashes:
- # .--. ==> .-.-.
- # [--. ==> [-.-.
- # .--] ==> .-.-]
- # [--] ==> [-.-]
- $dirspec = "[$dirspec]" unless $dirspec =~ /[\[<]/; # make legal
- $dirspec =~ s/^(\[|<)\./$1/;
- @dirs = split /(?<!\^)\./, vmspath($dirspec);
- $dirs[0] =~ s/^[\[<]//s; $dirs[-1] =~ s/[\]>]\Z(?!\n)//s;
- @dirs;
-}
-
-
-=item catpath (override)
-
-Construct a complete filespec using VMS syntax
-
-=cut
-
-sub catpath {
- my($self,$dev,$dir,$file) = @_;
-
- # We look for a volume in $dev, then in $dir, but not both
- my ($dir_volume, $dir_dir, $dir_file) = $self->splitpath($dir);
- $dev = $dir_volume unless length $dev;
- $dir = length $dir_file ? $self->catfile($dir_dir, $dir_file) : $dir_dir;
-
- if ($dev =~ m|^/+([^/]+)|) { $dev = "$1:"; }
- else { $dev .= ':' unless $dev eq '' or $dev =~ /:\Z(?!\n)/; }
- if (length($dev) or length($dir)) {
- $dir = "[$dir]" unless $dir =~ /[\[<\/]/;
- $dir = vmspath($dir);
- }
- "$dev$dir$file";
-}
-
-=item abs2rel (override)
-
-Use VMS syntax when converting filespecs.
-
-=cut
-
-sub abs2rel {
- my $self = shift;
- return vmspath(File::Spec::Unix::abs2rel( $self, @_ ))
- if grep m{/}, @_;
-
- my($path,$base) = @_;
- $base = $self->_cwd() unless defined $base and length $base;
-
- for ($path, $base) { $_ = $self->canonpath($_) }
-
- # Are we even starting $path on the same (node::)device as $base? Note that
- # logical paths or nodename differences may be on the "same device"
- # but the comparison that ignores device differences so as to concatenate
- # [---] up directory specs is not even a good idea in cases where there is
- # a logical path difference between $path and $base nodename and/or device.
- # Hence we fall back to returning the absolute $path spec
- # if there is a case blind device (or node) difference of any sort
- # and we do not even try to call $parse() or consult %ENV for $trnlnm()
- # (this module needs to run on non VMS platforms after all).
-
- my ($path_volume, $path_directories, $path_file) = $self->splitpath($path);
- my ($base_volume, $base_directories, $base_file) = $self->splitpath($base);
- return $path unless lc($path_volume) eq lc($base_volume);
-
- for ($path, $base) { $_ = $self->rel2abs($_) }
-
- # Now, remove all leading components that are the same
- my @pathchunks = $self->splitdir( $path_directories );
- my $pathchunks = @pathchunks;
- unshift(@pathchunks,'000000') unless $pathchunks[0] eq '000000';
- my @basechunks = $self->splitdir( $base_directories );
- my $basechunks = @basechunks;
- unshift(@basechunks,'000000') unless $basechunks[0] eq '000000';
-
- while ( @pathchunks &&
- @basechunks &&
- lc( $pathchunks[0] ) eq lc( $basechunks[0] )
- ) {
- shift @pathchunks ;
- shift @basechunks ;
- }
-
- # @basechunks now contains the directories to climb out of,
- # @pathchunks now has the directories to descend in to.
- if ((@basechunks > 0) || ($basechunks != $pathchunks)) {
- $path_directories = join '.', ('-' x @basechunks, @pathchunks) ;
- }
- else {
- $path_directories = join '.', @pathchunks;
- }
- $path_directories = '['.$path_directories.']';
- return $self->canonpath( $self->catpath( '', $path_directories, $path_file ) ) ;
-}
-
-
-=item rel2abs (override)
-
-Use VMS syntax when converting filespecs.
-
-=cut
-
-sub rel2abs {
- my $self = shift ;
- my ($path,$base ) = @_;
- return undef unless defined $path;
- if ($path =~ m/\//) {
- $path = ( -d $path || $path =~ m/\/\z/ # educated guessing about
- ? vmspath($path) # whether it's a directory
- : vmsify($path) );
- }
- $base = vmspath($base) if defined $base && $base =~ m/\//;
- # Clean up and split up $path
- if ( ! $self->file_name_is_absolute( $path ) ) {
- # Figure out the effective $base and clean it up.
- if ( !defined( $base ) || $base eq '' ) {
- $base = $self->_cwd;
- }
- elsif ( ! $self->file_name_is_absolute( $base ) ) {
- $base = $self->rel2abs( $base ) ;
- }
- else {
- $base = $self->canonpath( $base ) ;
- }
-
- # Split up paths
- my ( $path_directories, $path_file ) =
- ($self->splitpath( $path ))[1,2] ;
-
- my ( $base_volume, $base_directories ) =
- $self->splitpath( $base ) ;
-
- $path_directories = '' if $path_directories eq '[]' ||
- $path_directories eq '<>';
- my $sep = '' ;
- $sep = '.'
- if ( $base_directories =~ m{[^.\]>]\Z(?!\n)} &&
- $path_directories =~ m{^[^.\[<]}s
- ) ;
- $base_directories = "$base_directories$sep$path_directories";
- $base_directories =~ s{\.?[\]>][\[<]\.?}{.};
-
- $path = $self->catpath( $base_volume, $base_directories, $path_file );
- }
-
- return $self->canonpath( $path ) ;
-}
-
-
-# eliminate_macros() and fixpath() are MakeMaker-specific methods
-# which are used inside catfile() and catdir(). MakeMaker has its own
-# copies as of 6.06_03 which are the canonical ones. We leave these
-# here, in peace, so that File::Spec continues to work with MakeMakers
-# prior to 6.06_03.
-#
-# Please consider these two methods deprecated. Do not patch them,
-# patch the ones in ExtUtils::MM_VMS instead.
-sub eliminate_macros {
- my($self,$path) = @_;
- return '' unless (defined $path) && ($path ne '');
- $self = {} unless ref $self;
-
- if ($path =~ /\s/) {
- return join ' ', map { $self->eliminate_macros($_) } split /\s+/, $path;
- }
-
- my($npath) = unixify($path);
- my($complex) = 0;
- my($head,$macro,$tail);
-
- # perform m##g in scalar context so it acts as an iterator
- while ($npath =~ m#(.*?)\$\((\S+?)\)(.*)#gs) {
- if ($self->{$2}) {
- ($head,$macro,$tail) = ($1,$2,$3);
- if (ref $self->{$macro}) {
- if (ref $self->{$macro} eq 'ARRAY') {
- $macro = join ' ', @{$self->{$macro}};
- }
- else {
- print "Note: can't expand macro \$($macro) containing ",ref($self->{$macro}),
- "\n\t(using MMK-specific deferred substitutuon; MMS will break)\n";
- $macro = "\cB$macro\cB";
- $complex = 1;
- }
- }
- else { ($macro = unixify($self->{$macro})) =~ s#/\Z(?!\n)##; }
- $npath = "$head$macro$tail";
- }
- }
- if ($complex) { $npath =~ s#\cB(.*?)\cB#\${$1}#gs; }
- $npath;
-}
-
-# Deprecated. See the note above for eliminate_macros().
-sub fixpath {
- my($self,$path,$force_path) = @_;
- return '' unless $path;
- $self = bless {} unless ref $self;
- my($fixedpath,$prefix,$name);
-
- if ($path =~ /\s/) {
- return join ' ',
- map { $self->fixpath($_,$force_path) }
- split /\s+/, $path;
- }
-
- if ($path =~ m#^\$\([^\)]+\)\Z(?!\n)#s || $path =~ m#[/:>\]]#) {
- if ($force_path or $path =~ /(?:DIR\)|\])\Z(?!\n)/) {
- $fixedpath = vmspath($self->eliminate_macros($path));
- }
- else {
- $fixedpath = vmsify($self->eliminate_macros($path));
- }
- }
- elsif ((($prefix,$name) = ($path =~ m#^\$\(([^\)]+)\)(.+)#s)) && $self->{$prefix}) {
- my($vmspre) = $self->eliminate_macros("\$($prefix)");
- # is it a dir or just a name?
- $vmspre = ($vmspre =~ m|/| or $prefix =~ /DIR\Z(?!\n)/) ? vmspath($vmspre) : '';
- $fixedpath = ($vmspre ? $vmspre : $self->{$prefix}) . $name;
- $fixedpath = vmspath($fixedpath) if $force_path;
- }
- else {
- $fixedpath = $path;
- $fixedpath = vmspath($fixedpath) if $force_path;
- }
- # No hints, so we try to guess
- if (!defined($force_path) and $fixedpath !~ /[:>(.\]]/) {
- $fixedpath = vmspath($fixedpath) if -d $fixedpath;
- }
-
- # Trim off root dirname if it's had other dirs inserted in front of it.
- $fixedpath =~ s/\.000000([\]>])/$1/;
- # Special case for VMS absolute directory specs: these will have had device
- # prepended during trip through Unix syntax in eliminate_macros(), since
- # Unix syntax has no way to express "absolute from the top of this device's
- # directory tree".
- if ($path =~ /^[\[>][^.\-]/) { $fixedpath =~ s/^[^\[<]+//; }
- $fixedpath;
-}
-
-
-=back
-
-=head1 COPYRIGHT
-
-Copyright (c) 2004 by the Perl 5 Porters. 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
-
-See L<File::Spec> and L<File::Spec::Unix>. This package overrides the
-implementation of these methods, not the semantics.
-
-An explanation of VMS file specs can be found at
-L<"http://h71000.www7.hp.com/doc/731FINAL/4506/4506pro_014.html#apps_locating_naming_files">.
-
-=cut
-
-1;
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/File/Spec/Win32.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/File/Spec/Win32.pm
deleted file mode 100644
index 9b9034039fe..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/File/Spec/Win32.pm
+++ /dev/null
@@ -1,442 +0,0 @@
-package File::Spec::Win32;
-
-use strict;
-
-use vars qw(@ISA $VERSION);
-require File::Spec::Unix;
-
-$VERSION = '3.2701';
-
-@ISA = qw(File::Spec::Unix);
-
-# Some regexes we use for path splitting
-my $DRIVE_RX = '[a-zA-Z]:';
-my $UNC_RX = '(?:\\\\\\\\|//)[^\\\\/]+[\\\\/][^\\\\/]+';
-my $VOL_RX = "(?:$DRIVE_RX|$UNC_RX)";
-
-
-=head1 NAME
-
-File::Spec::Win32 - methods for Win32 file specs
-
-=head1 SYNOPSIS
-
- require File::Spec::Win32; # Done internally by File::Spec if needed
-
-=head1 DESCRIPTION
-
-See File::Spec::Unix for a documentation of the methods provided
-there. This package overrides the implementation of these methods, not
-the semantics.
-
-=over 4
-
-=item devnull
-
-Returns a string representation of the null device.
-
-=cut
-
-sub devnull {
- return "nul";
-}
-
-sub rootdir () { '\\' }
-
-
-=item tmpdir
-
-Returns a string representation of the first existing directory
-from the following list:
-
- $ENV{TMPDIR}
- $ENV{TEMP}
- $ENV{TMP}
- SYS:/temp
- C:\system\temp
- C:/temp
- /tmp
- /
-
-The SYS:/temp is preferred in Novell NetWare and the C:\system\temp
-for Symbian (the File::Spec::Win32 is used also for those platforms).
-
-Since Perl 5.8.0, if running under taint mode, and if the environment
-variables are tainted, they are not used.
-
-=cut
-
-my $tmpdir;
-sub tmpdir {
- return $tmpdir if defined $tmpdir;
- $tmpdir = $_[0]->_tmpdir( map( $ENV{$_}, qw(TMPDIR TEMP TMP) ),
- 'SYS:/temp',
- 'C:\system\temp',
- 'C:/temp',
- '/tmp',
- '/' );
-}
-
-=item case_tolerant
-
-MSWin32 case-tolerance depends on GetVolumeInformation() $ouFsFlags == FS_CASE_SENSITIVE,
-indicating the case significance when comparing file specifications.
-Since XP FS_CASE_SENSITIVE is effectively disabled for the NT subsubsystem.
-See http://cygwin.com/ml/cygwin/2007-07/msg00891.html
-Default: 1
-
-=cut
-
-sub case_tolerant () {
- eval { require Win32API::File; } or return 1;
- my $drive = shift || "C:";
- my $osFsType = "\0"x256;
- my $osVolName = "\0"x256;
- my $ouFsFlags = 0;
- Win32API::File::GetVolumeInformation($drive, $osVolName, 256, [], [], $ouFsFlags, $osFsType, 256 );
- if ($ouFsFlags & Win32API::File::FS_CASE_SENSITIVE()) { return 0; }
- else { return 1; }
-}
-
-=item file_name_is_absolute
-
-As of right now, this returns 2 if the path is absolute with a
-volume, 1 if it's absolute with no volume, 0 otherwise.
-
-=cut
-
-sub file_name_is_absolute {
-
- my ($self,$file) = @_;
-
- if ($file =~ m{^($VOL_RX)}o) {
- my $vol = $1;
- return ($vol =~ m{^$UNC_RX}o ? 2
- : $file =~ m{^$DRIVE_RX[\\/]}o ? 2
- : 0);
- }
- return $file =~ m{^[\\/]} ? 1 : 0;
-}
-
-=item catfile
-
-Concatenate one or more directory names and a filename to form a
-complete path ending with a filename
-
-=cut
-
-sub catfile {
- shift;
-
- # Legacy / compatibility support
- #
- shift, return _canon_cat( "/", @_ )
- if $_[0] eq "";
-
- # Compatibility with File::Spec <= 3.26:
- # catfile('A:', 'foo') should return 'A:\foo'.
- return _canon_cat( ($_[0].'\\'), @_[1..$#_] )
- if $_[0] =~ m{^$DRIVE_RX\z}o;
-
- return _canon_cat( @_ );
-}
-
-sub catdir {
- shift;
-
- # Legacy / compatibility support
- #
- return ""
- unless @_;
- shift, return _canon_cat( "/", @_ )
- if $_[0] eq "";
-
- # Compatibility with File::Spec <= 3.26:
- # catdir('A:', 'foo') should return 'A:\foo'.
- return _canon_cat( ($_[0].'\\'), @_[1..$#_] )
- if $_[0] =~ m{^$DRIVE_RX\z}o;
-
- return _canon_cat( @_ );
-}
-
-sub path {
- my @path = split(';', $ENV{PATH});
- s/"//g for @path;
- @path = grep length, @path;
- unshift(@path, ".");
- return @path;
-}
-
-=item canonpath
-
-No physical check on the filesystem, but a logical cleanup of a
-path. On UNIX eliminated successive slashes and successive "/.".
-On Win32 makes
-
- dir1\dir2\dir3\..\..\dir4 -> \dir\dir4 and even
- dir1\dir2\dir3\...\dir4 -> \dir\dir4
-
-=cut
-
-sub canonpath {
- # Legacy / compatibility support
- #
- return $_[1] if !defined($_[1]) or $_[1] eq '';
- return _canon_cat( $_[1] );
-}
-
-=item splitpath
-
- ($volume,$directories,$file) = File::Spec->splitpath( $path );
- ($volume,$directories,$file) = File::Spec->splitpath( $path, $no_file );
-
-Splits a path into volume, directory, and filename portions. Assumes that
-the last file is a path unless the path ends in '\\', '\\.', '\\..'
-or $no_file is true. On Win32 this means that $no_file true makes this return
-( $volume, $path, '' ).
-
-Separators accepted are \ and /.
-
-Volumes can be drive letters or UNC sharenames (\\server\share).
-
-The results can be passed to L</catpath> to get back a path equivalent to
-(usually identical to) the original path.
-
-=cut
-
-sub splitpath {
- my ($self,$path, $nofile) = @_;
- my ($volume,$directory,$file) = ('','','');
- if ( $nofile ) {
- $path =~
- m{^ ( $VOL_RX ? ) (.*) }sox;
- $volume = $1;
- $directory = $2;
- }
- else {
- $path =~
- m{^ ( $VOL_RX ? )
- ( (?:.*[\\/](?:\.\.?\Z(?!\n))?)? )
- (.*)
- }sox;
- $volume = $1;
- $directory = $2;
- $file = $3;
- }
-
- return ($volume,$directory,$file);
-}
-
-
-=item splitdir
-
-The opposite of L<catdir()|File::Spec/catdir()>.
-
- @dirs = File::Spec->splitdir( $directories );
-
-$directories must be only the directory portion of the path on systems
-that have the concept of a volume or that have path syntax that differentiates
-files from directories.
-
-Unlike just splitting the directories on the separator, leading empty and
-trailing directory entries can be returned, because these are significant
-on some OSs. So,
-
- File::Spec->splitdir( "/a/b/c" );
-
-Yields:
-
- ( '', 'a', 'b', '', 'c', '' )
-
-=cut
-
-sub splitdir {
- my ($self,$directories) = @_ ;
- #
- # split() likes to forget about trailing null fields, so here we
- # check to be sure that there will not be any before handling the
- # simple case.
- #
- if ( $directories !~ m|[\\/]\Z(?!\n)| ) {
- return split( m|[\\/]|, $directories );
- }
- else {
- #
- # since there was a trailing separator, add a file name to the end,
- # then do the split, then replace it with ''.
- #
- my( @directories )= split( m|[\\/]|, "${directories}dummy" ) ;
- $directories[ $#directories ]= '' ;
- return @directories ;
- }
-}
-
-
-=item catpath
-
-Takes volume, directory and file portions and returns an entire path. Under
-Unix, $volume is ignored, and this is just like catfile(). On other OSs,
-the $volume become significant.
-
-=cut
-
-sub catpath {
- my ($self,$volume,$directory,$file) = @_;
-
- # If it's UNC, make sure the glue separator is there, reusing
- # whatever separator is first in the $volume
- my $v;
- $volume .= $v
- if ( (($v) = $volume =~ m@^([\\/])[\\/][^\\/]+[\\/][^\\/]+\Z(?!\n)@s) &&
- $directory =~ m@^[^\\/]@s
- ) ;
-
- $volume .= $directory ;
-
- # If the volume is not just A:, make sure the glue separator is
- # there, reusing whatever separator is first in the $volume if possible.
- if ( $volume !~ m@^[a-zA-Z]:\Z(?!\n)@s &&
- $volume =~ m@[^\\/]\Z(?!\n)@ &&
- $file =~ m@[^\\/]@
- ) {
- $volume =~ m@([\\/])@ ;
- my $sep = $1 ? $1 : '\\' ;
- $volume .= $sep ;
- }
-
- $volume .= $file ;
-
- return $volume ;
-}
-
-sub _same {
- lc($_[1]) eq lc($_[2]);
-}
-
-sub rel2abs {
- my ($self,$path,$base ) = @_;
-
- my $is_abs = $self->file_name_is_absolute($path);
-
- # Check for volume (should probably document the '2' thing...)
- return $self->canonpath( $path ) if $is_abs == 2;
-
- if ($is_abs) {
- # It's missing a volume, add one
- my $vol = ($self->splitpath( $self->_cwd() ))[0];
- return $self->canonpath( $vol . $path );
- }
-
- if ( !defined( $base ) || $base eq '' ) {
- require Cwd ;
- $base = Cwd::getdcwd( ($self->splitpath( $path ))[0] ) if defined &Cwd::getdcwd ;
- $base = $self->_cwd() unless defined $base ;
- }
- elsif ( ! $self->file_name_is_absolute( $base ) ) {
- $base = $self->rel2abs( $base ) ;
- }
- else {
- $base = $self->canonpath( $base ) ;
- }
-
- my ( $path_directories, $path_file ) =
- ($self->splitpath( $path, 1 ))[1,2] ;
-
- my ( $base_volume, $base_directories ) =
- $self->splitpath( $base, 1 ) ;
-
- $path = $self->catpath(
- $base_volume,
- $self->catdir( $base_directories, $path_directories ),
- $path_file
- ) ;
-
- return $self->canonpath( $path ) ;
-}
-
-=back
-
-=head2 Note For File::Spec::Win32 Maintainers
-
-Novell NetWare inherits its File::Spec behaviour from File::Spec::Win32.
-
-=head1 COPYRIGHT
-
-Copyright (c) 2004,2007 by the Perl 5 Porters. 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
-
-See L<File::Spec> and L<File::Spec::Unix>. This package overrides the
-implementation of these methods, not the semantics.
-
-=cut
-
-
-sub _canon_cat(@) # @path -> path
-{
- my $first = shift;
- my $volume = $first =~ s{ \A ([A-Za-z]:) ([\\/]?) }{}x # drive letter
- ? ucfirst( $1 ).( $2 ? "\\" : "" )
- : $first =~ s{ \A (?:\\\\|//) ([^\\/]+)
- (?: [\\/] ([^\\/]+) )?
- [\\/]? }{}xs # UNC volume
- ? "\\\\$1".( defined $2 ? "\\$2" : "" )."\\"
- : $first =~ s{ \A [\\/] }{}x # root dir
- ? "\\"
- : "";
- my $path = join "\\", $first, @_;
-
- $path =~ tr#\\/#\\\\#s; # xx/yy --> xx\yy & xx\\yy --> xx\yy
-
- # xx/././yy --> xx/yy
- $path =~ s{(?:
- (?:\A|\\) # at begin or after a slash
- \.
- (?:\\\.)* # and more
- (?:\\|\z) # at end or followed by slash
- )+ # performance boost -- I do not know why
- }{\\}gx;
-
- # XXX I do not know whether more dots are supported by the OS supporting
- # this ... annotation (NetWare or symbian but not MSWin32).
- # Then .... could easily become ../../.. etc:
- # Replace \.\.\. by (\.\.\.+) and substitute with
- # { $1 . ".." . "\\.." x (length($2)-2) }gex
- # ... --> ../..
- $path =~ s{ (\A|\\) # at begin or after a slash
- \.\.\.
- (?=\\|\z) # at end or followed by slash
- }{$1..\\..}gx;
- # xx\yy\..\zz --> xx\zz
- while ( $path =~ s{(?:
- (?:\A|\\) # at begin or after a slash
- [^\\]+ # rip this 'yy' off
- \\\.\.
- (?<!\A\.\.\\\.\.) # do *not* replace ^..\..
- (?<!\\\.\.\\\.\.) # do *not* replace \..\..
- (?:\\|\z) # at end or followed by slash
- )+ # performance boost -- I do not know why
- }{\\}sx ) {}
-
- $path =~ s#\A\\##; # \xx --> xx NOTE: this is *not* root
- $path =~ s#\\\z##; # xx\ --> xx
-
- if ( $volume =~ m#\\\z# )
- { # <vol>\.. --> <vol>\
- $path =~ s{ \A # at begin
- \.\.
- (?:\\\.\.)* # and more
- (?:\\|\z) # at end or followed by slash
- }{}x;
-
- return $1 # \\HOST\SHARE\ --> \\HOST\SHARE
- if $path eq ""
- and $volume =~ m#\A(\\\\.*)\\\z#s;
- }
- return $path ne "" || $volume ? $volume.$path : ".";
-}
-
-1;
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/HTML/Entities.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/HTML/Entities.pm
deleted file mode 100644
index 1e7dfc1f069..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/HTML/Entities.pm
+++ /dev/null
@@ -1,491 +0,0 @@
-package HTML::Entities;
-
-# $Id: Entities.pm,v 1.35 2006/03/22 09:15:23 gisle Exp $
-
-=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. Under perl 5.6 and earlier only
-characters in the Latin-1 range are replaced. 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 compatiblity 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 (i.e., which to escape). 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, '<>&"');
-
-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 = sprintf("%d.%02d", q$Revision: 1.35 $ =~ /(\d+)\.(\d+)/);
-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 decode_entities_old
-{
- my $array;
- if (defined wantarray) {
- $array = [@_]; # copy
- } else {
- $array = \@_; # modify in-place
- }
- my $c;
- for (@$array) {
- s/(&\#(\d+);?)/$2 < 256 ? chr($2) : $1/eg;
- s/(&\#[xX]([0-9a-fA-F]+);?)/$c = hex($2); $c < 256 ? chr($c) : $1/eg;
- s/(&(\w+);?)/$entity2char{$2} || $1/eg;
- }
- wantarray ? @$array : $array->[0];
-}
-
-sub encode_entities
-{
- 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 $code = "sub {\$_[0] =~ s/([$_[1]])/\$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/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/HTML/Filter.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/HTML/Filter.pm
deleted file mode 100644
index 21fafac621a..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/HTML/Filter.pm
+++ /dev/null
@@ -1,112 +0,0 @@
-package HTML::Filter;
-
-use strict;
-use vars qw(@ISA $VERSION);
-
-require HTML::Parser;
-@ISA=qw(HTML::Parser);
-
-$VERSION = sprintf("%d.%02d", q$Revision: 2.11 $ =~ /(\d+)\.(\d+)/);
-
-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 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/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/HTML/HeadParser.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/HTML/HeadParser.pm
deleted file mode 100644
index a8974f832b6..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/HTML/HeadParser.pm
+++ /dev/null
@@ -1,259 +0,0 @@
-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="...">
-
-=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 will initialize headers with the prefix
-"C<X-Meta->" on the name. If the E<lt>meta> element contains a
-C<http-equiv> attribute, then it will be honored as the header 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 = sprintf("%d.%02d", q$Revision: 2.22 $ =~ /(\d+)\.(\d+)/);
-
-=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 isa or delegates to the C<HTTP::Headers> class.
-
-If no $header is given C<HTML::HeadParser> will create an
-C<HTTP::Header> 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 => 2,
- 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') {
- HTML::Entities::decode($text);
- $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)>
-
-
-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)) {
- return unless $attr->{'name'};
- $key = "X-Meta-\u$attr->{'name'}";
- }
- $self->{'header'}->push_header($key => $attr->{content});
- } elsif ($tag eq 'base') {
- return unless exists $attr->{href};
- $self->{'header'}->push_header('Content-Base' => $attr->{href});
- } 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|script|style)$/) {
- # 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 $h_val = "<" . delete($attr->{href}) . ">";
- for (sort keys %{$attr}) {
- $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) = @_;
- $text =~ s/\x{FEFF}//; # drop Unicode BOM if found
- print "TEXT[$text]\n" if $DEBUG;
- 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;
-}
-
-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/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/HTML/LinkExtor.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/HTML/LinkExtor.pm
deleted file mode 100644
index d543a5aba7b..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/HTML/LinkExtor.pm
+++ /dev/null
@@ -1,187 +0,0 @@
-package HTML::LinkExtor;
-
-# $Id: LinkExtor.pm,v 1.33 2003/10/10 10:20:56 gisle Exp $
-
-require HTML::Parser;
-@ISA = qw(HTML::Parser);
-$VERSION = sprintf("%d.%02d", q$Revision: 1.33 $ =~ /(\d+)\.(\d+)/);
-
-=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};
- push(@links, $a, $base ? URI->new($attr->{$a}, $base)->abs($base)
- : $attr->{$a});
- }
- 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 follwing 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 diffent 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/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/HTML/Parser.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/HTML/Parser.pm
deleted file mode 100644
index 72d5a9841fa..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/HTML/Parser.pm
+++ /dev/null
@@ -1,1233 +0,0 @@
-package HTML::Parser;
-
-# Copyright 1996-2007, Gisle Aas.
-# Copyright 1999-2000, Michael A. Chase.
-#
-# This library is free software; you can redistribute it and/or
-# modify it under the same terms as Perl itself.
-
-use strict;
-use vars qw($VERSION @ISA);
-
-$VERSION = '3.56'; # $Date: 2007/01/12 09:18:31 $
-
-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. The return
-value is normally a reference to the parser object (i.e. $p).
-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.
-
-=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->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 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 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. 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.
-
-=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>, 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>, 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/html40/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
-
-The 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 solution is to use the Encode::encode_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 parser can process raw undecoded UTF-8 sanely if the C<utf8_mode>
-is enabled or if the "attr", "@attr" or "dtext" argspecs is avoided.
-
-=item Parsing string decoded with wrong endianess
-
-(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)
-
-http://www.w3.org/TR/html4
-
-More information about marked sections and processing instructions may
-be found at C<http://www.sgml.u-net.com/book/sgml-8.htm>.
-
-=head1 COPYRIGHT
-
- Copyright 1996-2007 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/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/HTML/PullParser.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/HTML/PullParser.pm
deleted file mode 100644
index e851fe001d4..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/HTML/PullParser.pm
+++ /dev/null
@@ -1,211 +0,0 @@
-package HTML::PullParser;
-
-# $Id: PullParser.pm,v 2.9 2006/04/26 08:00:28 gisle Exp $
-
-require HTML::Parser;
-@ISA=qw(HTML::Parser);
-$VERSION = sprintf("%d.%02d", q$Revision: 2.9 $ =~ /(\d+)\.(\d+)/);
-
-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/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/HTML/TokeParser.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/HTML/TokeParser.pm
deleted file mode 100644
index a1b8837cb4d..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/HTML/TokeParser.pm
+++ /dev/null
@@ -1,371 +0,0 @@
-package HTML::TokeParser;
-
-# $Id: TokeParser.pm,v 2.37 2006/04/26 08:00:28 gisle Exp $
-
-require HTML::PullParser;
-@ISA=qw(HTML::PullParser);
-$VERSION = sprintf("%d.%02d", q$Revision: 2.37 $ =~ /(\d+)\.(\d+)/);
-
-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 {
- %cnf = @_;
- }
-
- my $textify = delete $cnf{textify} || {img => "alt", applet => "alt"};
-
- my $self = $class->SUPER::new(%cnf, %ARGS) || 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/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Math/BigInt/FastCalc.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Math/BigInt/FastCalc.pm
deleted file mode 100644
index 2b4aea58dc2..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Math/BigInt/FastCalc.pm
+++ /dev/null
@@ -1,125 +0,0 @@
-package Math::BigInt::FastCalc;
-
-use 5.006;
-use strict;
-# use warnings; # dont use warnings for older Perls
-
-use DynaLoader;
-use Math::BigInt::Calc;
-
-use vars qw/@ISA $VERSION $BASE $BASE_LEN/;
-
-@ISA = qw(DynaLoader);
-
-$VERSION = '0.19';
-
-bootstrap Math::BigInt::FastCalc $VERSION;
-
-##############################################################################
-# global constants, flags and accessory
-
-# announce that we are compatible with MBI v1.70 and up
-sub api_version () { 1; }
-
-BEGIN
- {
- # use Calc to override the methods that we do not provide in XS
-
- for my $method (qw/
- str
- add sub mul div
- rsft lsft
- mod modpow modinv
- gcd
- pow root sqrt log_int fac nok
- digit check
- from_hex from_bin from_oct as_hex as_bin as_oct
- zeros base_len
- xor or and
- alen 1ex
- /)
- {
- no strict 'refs';
- *{'Math::BigInt::FastCalc::_' . $method} = \&{'Math::BigInt::Calc::_' . $method};
- }
- my ($AND_BITS, $XOR_BITS, $OR_BITS, $BASE_LEN_SMALL, $MAX_VAL);
-
- # store BASE_LEN and BASE to later pass it to XS code
- ($BASE_LEN, $AND_BITS, $XOR_BITS, $OR_BITS, $BASE_LEN_SMALL, $MAX_VAL, $BASE) =
- Math::BigInt::Calc::_base_len();
-
- }
-
-sub import
- {
- _set_XS_BASE($BASE, $BASE_LEN);
- }
-
-##############################################################################
-##############################################################################
-
-1;
-__END__
-=pod
-
-=head1 NAME
-
-Math::BigInt::FastCalc - Math::BigInt::Calc with some XS for more speed
-
-=head1 SYNOPSIS
-
-Provides support for big integer calculations. Not intended to be used by
-other modules. Other modules which sport the same functions can also be used
-to support Math::BigInt, like L<Math::BigInt::GMP> or L<Math::BigInt::Pari>.
-
-=head1 DESCRIPTION
-
-In order to allow for multiple big integer libraries, Math::BigInt was
-rewritten to use library modules for core math routines. Any module which
-follows the same API as this can be used instead by using the following:
-
- use Math::BigInt lib => 'libname';
-
-'libname' is either the long name ('Math::BigInt::Pari'), or only the short
-version like 'Pari'. To use this library:
-
- use Math::BigInt lib => 'FastCalc';
-
-Note that from L<Math::BigInt> v1.76 onwards, FastCalc will be loaded
-automatically, if possible.
-
-=head1 STORAGE
-
-FastCalc works exactly like Calc, in stores the numbers in decimal form,
-chopped into parts.
-
-=head1 METHODS
-
-The following functions are now implemented in FastCalc.xs:
-
- _is_odd _is_even _is_one _is_zero
- _is_two _is_ten
- _zero _one _two _ten
- _acmp _len _num
- _inc _dec
- __strip_zeros _copy
-
-=head1 LICENSE
-
-This program is free software; you may redistribute it and/or modify it under
-the same terms as Perl itself.
-
-=head1 AUTHORS
-
-Original math code by Mark Biggar, rewritten by Tels L<http://bloodgate.com/>
-in late 2000.
-Seperated from BigInt and shaped API with the help of John Peacock.
-Fixed, sped-up and enhanced by Tels http://bloodgate.com 2001-2003.
-Further streamlining (api_version 1 etc.) by Tels 2004-2007.
-
-=head1 SEE ALSO
-
-L<Math::BigInt>, L<Math::BigFloat>,
-L<Math::BigInt::GMP>, L<Math::BigInt::FastCalc> and L<Math::BigInt::Pari>.
-
-=cut
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS.pm
deleted file mode 100644
index d8162e93d39..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS.pm
+++ /dev/null
@@ -1,967 +0,0 @@
-
-package Net::DNS;
-#
-# $Id: DNS.pm 710 2008-02-08 15:22:21Z olaf $
-#
-use strict;
-
-
-BEGIN {
- eval { require bytes; }
-}
-
-
-
-use vars qw(
- $HAVE_XS
- $VERSION
- $SVNVERSION
- $DNSSEC
- $DN_EXPAND_ESCAPES
- @ISA
- @EXPORT
- @EXPORT_OK
- %typesbyname
- %typesbyval
- %qtypesbyname
- %qtypesbyval
- %metatypesbyname
- %metatypesbyval
- %classesbyname
- %classesbyval
- %opcodesbyname
- %opcodesbyval
- %rcodesbyname
- %rcodesbyval
-);
-
-
-
-BEGIN {
- require DynaLoader;
- require Exporter;
- @ISA = qw(Exporter DynaLoader);
-
-
- $VERSION = '0.63';
- $SVNVERSION = (qw$LastChangedRevision: 710 $)[1];
-
- $HAVE_XS = eval {
- local $SIG{'__DIE__'} = 'DEFAULT';
- __PACKAGE__->bootstrap(); 1
- } ? 1 : 0;
-
-}
-
-
-
-BEGIN {
-
- $DNSSEC = eval {
- local $SIG{'__DIE__'} = 'DEFAULT';
- require Net::DNS::SEC;
- 1
- } ? 1 : 0;
-
-
-}
-
-
-use Net::DNS::Resolver;
-use Net::DNS::Packet;
-use Net::DNS::Update;
-use Net::DNS::Header;
-use Net::DNS::Question;
-use Net::DNS::RR; # use only after $Net::DNS::DNSSEC has been evaluated
-use Carp;
-
-@EXPORT = qw(mx yxrrset nxrrset yxdomain nxdomain rr_add rr_del);
-@EXPORT_OK= qw(name2labels wire2presentation rrsort);
-
-
-#
-# If you implement an RR record make sure you also add it to
-# %Net::DNS::RR::RR hash otherwise it will be treated as unknown type.
-#
-
-# Do not use these tybesby hashes directly. Use the interface
-# functions, see below.
-
-%typesbyname = (
- 'SIGZERO' => 0, # RFC2931 consider this a pseudo type
- 'A' => 1, # RFC 1035, Section 3.4.1
- 'NS' => 2, # RFC 1035, Section 3.3.11
- 'MD' => 3, # RFC 1035, Section 3.3.4 (obsolete)
- 'MF' => 4, # RFC 1035, Section 3.3.5 (obsolete)
- 'CNAME' => 5, # RFC 1035, Section 3.3.1
- 'SOA' => 6, # RFC 1035, Section 3.3.13
- 'MB' => 7, # RFC 1035, Section 3.3.3
- 'MG' => 8, # RFC 1035, Section 3.3.6
- 'MR' => 9, # RFC 1035, Section 3.3.8
- 'NULL' => 10, # RFC 1035, Section 3.3.10
- 'WKS' => 11, # RFC 1035, Section 3.4.2 (deprecated)
- 'PTR' => 12, # RFC 1035, Section 3.3.12
- 'HINFO' => 13, # RFC 1035, Section 3.3.2
- 'MINFO' => 14, # RFC 1035, Section 3.3.7
- 'MX' => 15, # RFC 1035, Section 3.3.9
- 'TXT' => 16, # RFC 1035, Section 3.3.14
- 'RP' => 17, # RFC 1183, Section 2.2
- 'AFSDB' => 18, # RFC 1183, Section 1
- 'X25' => 19, # RFC 1183, Section 3.1
- 'ISDN' => 20, # RFC 1183, Section 3.2
- 'RT' => 21, # RFC 1183, Section 3.3
- 'NSAP' => 22, # RFC 1706, Section 5
- 'NSAP_PTR' => 23, # RFC 1348 (obsolete)
- # The following 2 RRs are impemented in Net::DNS::SEC
- 'SIG' => 24, # RFC 2535, Section 4.1
- 'KEY' => 25, # RFC 2535, Section 3.1
- 'PX' => 26, # RFC 2163,
- 'GPOS' => 27, # RFC 1712 (obsolete)
- 'AAAA' => 28, # RFC 1886, Section 2.1
- 'LOC' => 29, # RFC 1876
- # The following RR is impemented in Net::DNS::SEC
- 'NXT' => 30, # RFC 2535, Section 5.2 obsoleted by RFC3755
- 'EID' => 31, # draft-ietf-nimrod-dns-xx.txt
- 'NIMLOC' => 32, # draft-ietf-nimrod-dns-xx.txt
- 'SRV' => 33, # RFC 2052
- 'ATMA' => 34, # ???
- 'NAPTR' => 35, # RFC 2168
- 'KX' => 36, # RFC 2230
- 'CERT' => 37, # RFC 2538
- 'DNAME' => 39, # RFC 2672
- 'OPT' => 41, # RFC 2671
- 'DS' => 43, # RFC 4034 # in Net::DNS::SEC
- 'SSHFP' => 44, # draft-ietf-secsh-dns (No RFC # yet at time of coding)
- 'IPSECKEY' => 45, # RFC 4025
- 'RRSIG' => 46, # RFC 4034 in Net::DNS::SEC
- 'NSEC' => 47, # RFC 4034 in Net::DNS::SEC
- 'DNSKEY' => 48, # RFC 4034 in Net::DNS::SEC
- 'NSEC3' => 50, # draft-ietf-dnsext-nsec3-10 (assignment made at time of code release)
- 'NSEC3PARAM' => 51, # draft-ietf-dnsext-nsec3-10 (assignment made at time of code release)
-
- 'SPF' => 99, # RFC 4408
- 'UINFO' => 100, # non-standard
- 'UID' => 101, # non-standard
- 'GID' => 102, # non-standard
- 'UNSPEC' => 103, # non-standard
- 'TKEY' => 249, # RFC 2930
- 'TSIG' => 250, # RFC 2931
- 'IXFR' => 251, # RFC 1995
- 'AXFR' => 252, # RFC 1035
- 'MAILB' => 253, # RFC 1035 (MB, MG, MR)
- 'MAILA' => 254, # RFC 1035 (obsolete - see MX)
- 'ANY' => 255, # RFC 1035
- 'DLV' => 32769 # RFC 4431 in Net::DNS::SEC
-);
-%typesbyval = reverse %typesbyname;
-
-
-#
-# typesbyval and typesbyname functions are wrappers around the similarly named
-# hashes. They are used for 'unknown' DNS RR types (RFC3597)
-
-# typesbyname returns they TYPEcode as a function of the TYPE
-# mnemonic. If the TYPE mapping is not specified the generic mnemonic
-# TYPE### is returned.
-
-
-# typesbyval returns they TYPE mnemonic as a function of the TYPE
-# code. If the TYPE mapping is not specified the generic mnemonic
-# TYPE### is returned.
-#
-
-sub typesbyname {
- my $name = uc shift;
-
- return $typesbyname{$name} if defined $typesbyname{$name};
-
- confess "Net::DNS::typesbyname() argument ($name) is not TYPE###" unless
- $name =~ m/^\s*TYPE(\d+)\s*$/o;
-
- my $val = $1;
-
- confess 'Net::DNS::typesbyname() argument larger than ' . 0xffff if $val > 0xffff;
-
- return $val;
-}
-
-
-
-sub typesbyval {
- my $val = shift;
- confess "Net::DNS::typesbyval() argument is not defined" unless defined $val;
- confess "Net::DNS::typesbyval() argument ($val) is not numeric" unless
- $val =~ s/^\s*0*(\d+)\s*$/$1/o;
-
-
-
- return $typesbyval{$val} if $typesbyval{$val};
-
- confess 'Net::DNS::typesbyval() argument larger than '. 0xffff if
- $val > 0xffff;
-
- return "TYPE$val";
-}
-
-
-
-#
-# Do not use these classesby hashes directly. See below.
-#
-
-%classesbyname = (
- 'IN' => 1, # RFC 1035
- 'CH' => 3, # RFC 1035
- 'HS' => 4, # RFC 1035
- 'NONE' => 254, # RFC 2136
- 'ANY' => 255, # RFC 1035
-);
-%classesbyval = reverse %classesbyname;
-
-
-
-# classesbyval and classesbyname functions are wrappers around the
-# similarly named hashes. They are used for 'unknown' DNS RR classess
-# (RFC3597)
-
-# See typesbyval and typesbyname, these beasts have the same functionality
-
-sub classesbyname {
- my $name = uc shift;
- return $classesbyname{$name} if $classesbyname{$name};
-
- confess "Net::DNS::classesbyval() argument is not CLASS### ($name)" unless
- $name =~ m/^\s*CLASS(\d+)\s*$/o;
-
- my $val = $1;
-
- confess 'Net::DNS::classesbyval() argument larger than '. 0xffff if $val > 0xffff;
-
- return $val;
-}
-
-
-
-sub classesbyval {
- my $val = shift;
-
- confess "Net::DNS::classesbyname() argument is not numeric ($val)" unless
- $val =~ s/^\s*0*([0-9]+)\s*$/$1/o;
-
- return $classesbyval{$val} if $classesbyval{$val};
-
- confess 'Net::DNS::classesbyname() argument larger than ' . 0xffff if $val > 0xffff;
-
- return "CLASS$val";
-}
-
-
-
-# The qtypesbyval and metatypesbyval specify special typecodes
-# See rfc2929 and the relevant IANA registry
-# http://www.iana.org/assignments/dns-parameters
-
-
-%qtypesbyname = (
- 'IXFR' => 251, # incremental transfer [RFC1995]
- 'AXFR' => 252, # transfer of an entire zone [RFC1035]
- 'MAILB' => 253, # mailbox-related RRs (MB, MG or MR) [RFC1035]
- 'MAILA' => 254, # mail agent RRs (Obsolete - see MX) [RFC1035]
- 'ANY' => 255, # all records [RFC1035]
-);
-%qtypesbyval = reverse %qtypesbyname;
-
-
-%metatypesbyname = (
- 'TKEY' => 249, # Transaction Key [RFC2930]
- 'TSIG' => 250, # Transaction Signature [RFC2845]
- 'OPT' => 41, # RFC 2671
-);
-%metatypesbyval = reverse %metatypesbyname;
-
-
-%opcodesbyname = (
- 'QUERY' => 0, # RFC 1035
- 'IQUERY' => 1, # RFC 1035
- 'STATUS' => 2, # RFC 1035
- 'NS_NOTIFY_OP' => 4, # RFC 1996
- 'UPDATE' => 5, # RFC 2136
-);
-%opcodesbyval = reverse %opcodesbyname;
-
-
-%rcodesbyname = (
- 'NOERROR' => 0, # RFC 1035
- 'FORMERR' => 1, # RFC 1035
- 'SERVFAIL' => 2, # RFC 1035
- 'NXDOMAIN' => 3, # RFC 1035
- 'NOTIMP' => 4, # RFC 1035
- 'REFUSED' => 5, # RFC 1035
- 'YXDOMAIN' => 6, # RFC 2136
- 'YXRRSET' => 7, # RFC 2136
- 'NXRRSET' => 8, # RFC 2136
- 'NOTAUTH' => 9, # RFC 2136
- 'NOTZONE' => 10, # RFC 2136
-);
-%rcodesbyval = reverse %rcodesbyname;
-
-
-sub version { $VERSION; }
-sub PACKETSZ () { 512; }
-sub HFIXEDSZ () { 12; }
-sub QFIXEDSZ () { 4; }
-sub RRFIXEDSZ () { 10; }
-sub INT32SZ () { 4; }
-sub INT16SZ () { 2; }
-
-
-
-# mx()
-#
-# Usage:
-# my @mxes = mx('example.com', 'IN');
-#
-sub mx {
- my $res = ref $_[0] ? shift : Net::DNS::Resolver->new;
-
- my ($name, $class) = @_;
- $class ||= 'IN';
-
- my $ans = $res->query($name, 'MX', $class) || return;
-
- # This construct is best read backwords.
- #
- # First we take the answer secion of the packet.
- # Then we take just the MX records from that list
- # Then we sort the list by preference
- # Then we return it.
- # We do this into an array to force list context.
- my @ret = sort { $a->preference <=> $b->preference }
- grep { $_->type eq 'MX'} $ans->answer;
-
-
- return @ret;
-}
-
-sub yxrrset {
- return Net::DNS::RR->new_from_string(shift, 'yxrrset');
-}
-
-sub nxrrset {
- return Net::DNS::RR->new_from_string(shift, 'nxrrset');
-}
-
-sub yxdomain {
- return Net::DNS::RR->new_from_string(shift, 'yxdomain');
-}
-
-sub nxdomain {
- return Net::DNS::RR->new_from_string(shift, 'nxdomain');
-}
-
-sub rr_add {
- return Net::DNS::RR->new_from_string(shift, 'rr_add');
-}
-
-sub rr_del {
- return Net::DNS::RR->new_from_string(shift, 'rr_del');
-}
-
-
-
-# Utility function
-#
-# name2labels to translate names from presentation format into an
-# array of "wire-format" labels.
-
-
-# in: $dname a string with a domain name in presentation format (1035
-# sect 5.1)
-# out: an array of labels in wire format.
-
-
-sub name2labels {
- my $dname=shift;
- my @names;
- my $j=0;
- while ($dname){
- ($names[$j],$dname)=presentation2wire($dname);
- $j++;
- }
-
- return @names;
-}
-
-
-
-
-sub wire2presentation {
- my $wire=shift;
- my $presentation="";
- my $length=length($wire);
- # There must be a nice regexp to do this.. but since I failed to
- # find one I scan the name string until I find a '\', at that time
- # I start looking forward and do the magic.
-
- my $i=0;
-
- while ($i < $length ){
- my $char=unpack("x".$i."C1",$wire);
- if ( $char < 33 || $char > 126 ){
- $presentation.= sprintf ("\\%03u" ,$char);
- }elsif ( $char == ord( "\"" )) {
- $presentation.= "\\\"";
- }elsif ( $char == ord( "\$" )) {
- $presentation.= "\\\$";
- }elsif ( $char == ord( "(" )) {
- $presentation.= "\\(";
- }elsif ( $char == ord( ")" )) {
- $presentation.= "\\)";
- }elsif ( $char == ord( ";" )) {
- $presentation.= "\\;";
- }elsif ( $char == ord( "@" )) {
- $presentation.= "\\@";
- }elsif ( $char == ord( "\\" )) {
- $presentation.= "\\\\" ;
- }elsif ( $char==ord (".") ){
- $presentation.= "\\." ;
- }else{
- $presentation.=chr($char) ;
- }
- $i++;
- }
-
- return $presentation;
-
-}
-
-
-
-# ($wire,$leftover)=presentation2wire($leftover);
-
-# Will parse the input presentation format and return everything before
-# the first non-escaped "." in the first element of the return array and
-# all that has not been parsed yet in the 2nd argument.
-
-
-sub presentation2wire {
- my $presentation=shift;
- my $wire="";
- my $length=length($presentation);
-
- my $i=0;
-
- while ($i < $length ){
- my $char=unpack("x".$i."C1",$presentation);
- if ( $char == ord ('.')){
- return ($wire,substr($presentation,$i+1));
- }
- if ( $char == ord ('\\')){
- #backslash found
- pos($presentation)=$i+1;
- if ($presentation=~/\G(\d\d\d)/){
- $wire.=pack("C",$1);
- $i+=3;
- }elsif($presentation=~/\Gx([0..9a..fA..F][0..9a..fA..F])/){
- $wire.=pack("H*",$1);
- $i+=3;
- }elsif($presentation=~/\G\./){
- $wire.="\.";
- $i+=1;
- }elsif($presentation=~/\G@/){
- $wire.="@";
- $i+=1;
- }elsif($presentation=~/\G\(/){
- $wire.="(";
- $i+=1;
- }elsif($presentation=~/\G\)/){
- $wire.=")";
- $i+=1;
- }elsif($presentation=~/\G\\/){
- $wire.="\\";
- $i+=1;
- }
- }else{
- $wire .= pack("C",$char);
- }
- $i++;
- }
-
- return $wire;
-}
-
-
-
-
-
-sub rrsort {
- my ($rrtype,$attribute,@rr_array)=@_;
- unless (exists($Net::DNS::typesbyname{uc($rrtype)})){
- # unvalid error type
- return();
- }
- unless (defined($attribute)){
- # no second argument... hence no array.
- return();
- }
-
- # attribute is empty or not specified.
-
- if( ref($attribute)=~/^Net::DNS::RR::.*/){
- # push the attribute back on the array.
- push @rr_array,$attribute;
- undef($attribute);
-
- }
-
- my @extracted_rr;
- foreach my $rr (@rr_array){
- push( @extracted_rr, $rr )if (uc($rr->type) eq uc($rrtype));
- }
- return () unless @extracted_rr;
- my $func=("Net::DNS::RR::".$rrtype)->get_rrsort_func($attribute);
- my @sorted=sort $func @extracted_rr;
- return @sorted;
-
-}
-
-
-
-
-
-
-
-
-
-1;
-__END__
-
-=head1 NAME
-
-Net::DNS - Perl interface to the DNS resolver
-
-=head1 SYNOPSIS
-
-C<use Net::DNS;>
-
-=head1 DESCRIPTION
-
-Net::DNS is a collection of Perl modules that act as a Domain
-Name System (DNS) resolver. It allows the programmer to perform
-DNS queries that are beyond the capabilities of C<gethostbyname>
-and C<gethostbyaddr>.
-
-The programmer should be somewhat familiar with the format of
-a DNS packet and its various sections. See RFC 1035 or
-I<DNS and BIND> (Albitz & Liu) for details.
-
-=head2 Resolver Objects
-
-A resolver object is an instance of the
-L<Net::DNS::Resolver|Net::DNS::Resolver> class. A program can have
-multiple resolver objects, each maintaining its own state information
-such as the nameservers to be queried, whether recursion is desired,
-etc.
-
-=head2 Packet Objects
-
-L<Net::DNS::Resolver|Net::DNS::Resolver> queries return
-L<Net::DNS::Packet|Net::DNS::Packet> objects. Packet objects have five
-sections:
-
-=over 3
-
-=item *
-
-The header section, a L<Net::DNS::Header|Net::DNS::Header> object.
-
-=item *
-
-The question section, a list of L<Net::DNS::Question|Net::DNS::Question>
-objects.
-
-=item *
-
-The answer section, a list of L<Net::DNS::RR|Net::DNS::RR> objects.
-
-=item *
-
-The authority section, a list of L<Net::DNS::RR|Net::DNS::RR> objects.
-
-=item *
-
-The additional section, a list of L<Net::DNS::RR|Net::DNS::RR> objects.
-
-=back
-
-=head2 Update Objects
-
-The L<Net::DNS::Update|Net::DNS::Update> package is a subclass of
-L<Net::DNS::Packet|Net::DNS::Packet> for creating packet objects to be
-used in dynamic updates.
-
-=head2 Header Objects
-
-L<Net::DNS::Header|Net::DNS::Header> objects represent the header
-section of a DNS packet.
-
-=head2 Question Objects
-
-L<Net::DNS::Question|Net::DNS::Question> objects represent the question
-section of a DNS packet.
-
-=head2 RR Objects
-
-L<Net::DNS::RR|Net::DNS::RR> is the base class for DNS resource record
-(RR) objects in the answer, authority, and additional sections of a DNS
-packet.
-
-Don't assume that RR objects will be of the type you requested -- always
-check an RR object's type before calling any of its methods.
-
-=head1 METHODS
-
-See the manual pages listed above for other class-specific methods.
-
-=head2 version
-
- print Net::DNS->version, "\n";
-
-Returns the version of Net::DNS.
-
-=head2 mx
-
- # Use a default resolver -- can't get an error string this way.
- use Net::DNS;
- my @mx = mx("example.com");
-
- # Use your own resolver object.
- use Net::DNS;
- my $res = Net::DNS::Resolver->new;
- my @mx = mx($res, "example.com");
-
-Returns a list of L<Net::DNS::RR::MX|Net::DNS::RR::MX> objects
-representing the MX records for the specified name; the list will be
-sorted by preference. Returns an empty list if the query failed or no MX
-records were found.
-
-This method does not look up A records -- it only performs MX queries.
-
-See L</EXAMPLES> for a more complete example.
-
-=head2 yxrrset
-
-Use this method to add an "RRset exists" prerequisite to a dynamic
-update packet. There are two forms, value-independent and
-value-dependent:
-
- # RRset exists (value-independent)
- $update->push(pre => yxrrset("host.example.com A"));
-
-Meaning: At least one RR with the specified name and type must
-exist.
-
- # RRset exists (value-dependent)
- $packet->push(pre => yxrrset("host.example.com A 10.1.2.3"));
-
-Meaning: At least one RR with the specified name and type must
-exist and must have matching data.
-
-Returns a C<Net::DNS::RR> object or C<undef> if the object couldn't
-be created.
-
-=head2 nxrrset
-
-Use this method to add an "RRset does not exist" prerequisite to
-a dynamic update packet.
-
- $packet->push(pre => nxrrset("host.example.com A"));
-
-Meaning: No RRs with the specified name and type can exist.
-
-Returns a C<Net::DNS::RR> object or C<undef> if the object couldn't
-be created.
-
-=head2 yxdomain
-
-Use this method to add a "name is in use" prerequisite to a dynamic
-update packet.
-
- $packet->push(pre => yxdomain("host.example.com"));
-
-Meaning: At least one RR with the specified name must exist.
-
-Returns a C<Net::DNS::RR> object or C<undef> if the object couldn't
-be created.
-
-=head2 nxdomain
-
-Use this method to add a "name is not in use" prerequisite to a
-dynamic update packet.
-
- $packet->push(pre => nxdomain("host.example.com"));
-
-Meaning: No RR with the specified name can exist.
-
-Returns a C<Net::DNS::RR> object or C<undef> if the object couldn't
-be created.
-
-=head2 rr_add
-
-Use this method to add RRs to a zone.
-
- $packet->push(update => rr_add("host.example.com A 10.1.2.3"));
-
-Meaning: Add this RR to the zone.
-
-RR objects created by this method should be added to the "update"
-section of a dynamic update packet. The TTL defaults to 86400
-seconds (24 hours) if not specified.
-
-Returns a C<Net::DNS::RR> object or C<undef> if the object couldn't
-be created.
-
-=head2 rr_del
-
-Use this method to delete RRs from a zone. There are three forms:
-delete an RRset, delete all RRsets, and delete an RR.
-
- # Delete an RRset.
- $packet->push(update => rr_del("host.example.com A"));
-
-Meaning: Delete all RRs having the specified name and type.
-
- # Delete all RRsets.
- $packet->push(update => rr_del("host.example.com"));
-
-Meaning: Delete all RRs having the specified name.
-
- # Delete an RR.
- $packet->push(update => rr_del("host.example.com A 10.1.2.3"));
-
-Meaning: Delete all RRs having the specified name, type, and data.
-
-RR objects created by this method should be added to the "update"
-section of a dynamic update packet.
-
-Returns a C<Net::DNS::RR> object or C<undef> if the object couldn't
-be created.
-
-
-=head2 Sorting of RR arrays
-
-As of version 0.55 there is functionality to help you sort RR
-arrays. 'rrsort()' is the function that is available to do the
-sorting. In most cases rrsort will give you the answer that you
-want but you can specify your own sorting method by using the
-Net::DNS::RR::FOO->set_rrsort_func() class method. See L<Net::DNS::RR>
-for details.
-
-=head3 rrsort()
-
- use Net::DNS qw(rrsort);
-
- my @prioritysorted=rrsort("SRV","priority",@rr_array);
-
-
-rrsort() selects all RRs from the input array that are of the type
-that are defined in the first argument. Those RRs are sorted based on
-the attribute that is specified as second argument.
-
-There are a number of RRs for which the sorting function is
-specifically defined for certain attributes. If such sorting function
-is defined in the code (it can be set or overwritten using the
-set_rrsort_func() class method) that function is used.
-
-For instance:
- my @prioritysorted=rrsort("SRV","priority",@rr_array);
-returns the SRV records sorted from lowest to heighest priority and
-for equal priorities from heighes to lowes weight.
-
-If the function does not exist then a numerical sort on the attribute
-value is performed.
- my @portsorted=rrsort("SRV","port",@rr_array);
-
-If the attribute does not exist for a certain RR than the RRs are
-sorted on string comparrisson of the rdata.
-
-If the attribute is not defined than either the default_sort function
-will be defined or "Canonical sorting" (as defined by DNSSEC) will be
-used.
-
-rrsort() returns a sorted array with only elements of the specified
-RR type or undef.
-
-rrsort() returns undef when arguments are incorrect.
-
-
-
-=head1 EXAMPLES
-
-The following examples show how to use the C<Net::DNS> modules.
-See the other manual pages and the demo scripts included with the
-source code for additional examples.
-
-See the C<Net::DNS::Update> manual page for an example of performing
-dynamic updates.
-
-=head2 Look up a host's addresses.
-
- use Net::DNS;
- my $res = Net::DNS::Resolver->new;
- my $query = $res->search("host.example.com");
-
- if ($query) {
- foreach my $rr ($query->answer) {
- next unless $rr->type eq "A";
- print $rr->address, "\n";
- }
- } else {
- warn "query failed: ", $res->errorstring, "\n";
- }
-
-=head2 Find the nameservers for a domain.
-
- use Net::DNS;
- my $res = Net::DNS::Resolver->new;
- my $query = $res->query("example.com", "NS");
-
- if ($query) {
- foreach $rr (grep { $_->type eq 'NS' } $query->answer) {
- print $rr->nsdname, "\n";
- }
- }
- else {
- warn "query failed: ", $res->errorstring, "\n";
- }
-
-=head2 Find the MX records for a domain.
-
- use Net::DNS;
- my $name = "example.com";
- my $res = Net::DNS::Resolver->new;
- my @mx = mx($res, $name);
-
- if (@mx) {
- foreach $rr (@mx) {
- print $rr->preference, " ", $rr->exchange, "\n";
- }
- } else {
- warn "Can't find MX records for $name: ", $res->errorstring, "\n";
- }
-
-
-=head2 Print a domain's SOA record in zone file format.
-
- use Net::DNS;
- my $res = Net::DNS::Resolver->new;
- my $query = $res->query("example.com", "SOA");
-
- if ($query) {
- ($query->answer)[0]->print;
- } else {
- print "query failed: ", $res->errorstring, "\n";
- }
-
-=head2 Perform a zone transfer and print all the records.
-
- use Net::DNS;
- my $res = Net::DNS::Resolver->new;
- $res->nameservers("ns.example.com");
-
- my @zone = $res->axfr("example.com");
-
- foreach $rr (@zone) {
- $rr->print;
- }
-
-=head2 Perform a background query and do some other work while waiting
-for the answer.
-
- use Net::DNS;
- my $res = Net::DNS::Resolver->new;
- my $socket = $res->bgsend("host.example.com");
-
- until ($res->bgisready($socket)) {
- # do some work here while waiting for the answer
- # ...and some more here
- }
-
- my $packet = $res->bgread($socket);
- $packet->print;
-
-
-=head2 Send a background query and use select to determine when the answer
-has arrived.
-
- use Net::DNS;
- use IO::Select;
-
- my $timeout = 5;
- my $res = Net::DNS::Resolver->new;
- my $bgsock = $res->bgsend("host.example.com");
- my $sel = IO::Select->new($bgsock);
-
- # Add more sockets to $sel if desired.
- my @ready = $sel->can_read($timeout);
- if (@ready) {
- foreach my $sock (@ready) {
- if ($sock == $bgsock) {
- my $packet = $res->bgread($bgsock);
- $packet->print;
- $bgsock = undef;
- }
- # Check for the other sockets.
- $sel->remove($sock);
- $sock = undef;
- }
- } else {
- warn "timed out after $timeout seconds\n";
- }
-
-=head1 BUGS
-
-C<Net::DNS> is slow.
-
-For other items to be fixed, please see the TODO file included with
-the source distribution.
-
-=head1 COPYRIGHT
-
-Copyright (c) 1997-2002 Michael Fuhr.
-Portions Copyright (c) 2002-2004 Chris Reinhardt.
-Portions Copyright (c) 2005 Olaf Kolkman (RIPE NCC)
-Portions Copyright (c) 2006 Olaf Kolkman (NLnet Labs)
-
-All rights reserved. This program is free software; you may redistribute
-it and/or modify it under the same terms as Perl itself.
-
-=head1 AUTHOR INFORMATION
-
-Net::DNS is currently maintained at NLnet Labs (www.nlnetlabs.nl) by:
- Olaf Kolkman
- olaf@net-dns.org
-
-Between 2002 and 2004 Net::DNS was maintained by:
- Chris Reinhardt
-
-
-Net::DNS was created by:
- Michael Fuhr
- mike@fuhr.org
-
-
-
-For more information see:
- http://www.net-dns.org/
-
-Stay tuned and syncicate:
- http://www.net-dns.org/blog/
-
-=head1 SEE ALSO
-
-L<perl(1)>, L<Net::DNS::Resolver>, L<Net::DNS::Packet>, L<Net::DNS::Update>,
-L<Net::DNS::Header>, L<Net::DNS::Question>, L<Net::DNS::RR>, RFC 1035,
-I<DNS and BIND> by Paul Albitz & Cricket Liu
-
-=cut
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/FAQ.pod b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/FAQ.pod
deleted file mode 100644
index f1b4e5c707e..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/FAQ.pod
+++ /dev/null
@@ -1,45 +0,0 @@
-=head1 NAME
-
-Net::DNS::FAQ - Frequently Asked Net::DNS Questions
-
-=head1 SYNOPSIS
-
- perldoc Net::DNS::FAQ
-
-=head1 DESCRIPTION
-
-This document serves to answer the most frequently asked questions on both the
-Net::DNS Mailing List and those sent to the author.
-
-The latest version of this FAQ can be found at
- http://www.net-dns.org/docs/FAQ.html
-
-=head1 GENERAL
-
-=head2 What is Net::DNS?
-
-Net::DNS is a perl implementation of a DNS resolver.
-
-=head1 INSTALLATION
-
-=head2 Where can I find Test::More?
-
-Test::More is part of the Test-Simple packge, by Michael G Schwern.
-You should be able to find the distrubution here:
-
- http://search.cpan.org/dist/Test-Simple/
-
-=head1 USAGE
-
-=head2 Why does Net::DNS::Resolver::query() return undef when the ANSWER section is empty?
-
-The short answer is, don't use query(). Net::DNS::Resolver::send()
-will always return the answer packet, as long as an answer was received.
-
-The longer answer is that query() is modeled after the res_query() function
-from the libresolv C library, which has similar behaviors.
-
-=head1 VERSION
-
- $Id: FAQ.pod 264 2005-04-06 09:16:15Z olaf $
-
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/Header.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/Header.pm
deleted file mode 100644
index 26627accdc7..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/Header.pm
+++ /dev/null
@@ -1,371 +0,0 @@
-package Net::DNS::Header;
-#
-# $Id: Header.pm 704 2008-02-06 21:30:59Z olaf $
-#
-
-use strict;
-
-BEGIN {
- eval { require bytes; }
-}
-
-
-use vars qw($VERSION $AUTOLOAD);
-
-use Carp;
-use Net::DNS;
-
-use constant MAX_ID => 65535;
-
-$VERSION = (qw$LastChangedRevision: 704 $)[1];
-
-=head1 NAME
-
-Net::DNS::Header - DNS packet header class
-
-=head1 SYNOPSIS
-
-C<use Net::DNS::Header;>
-
-=head1 DESCRIPTION
-
-A C<Net::DNS::Header> object represents the header portion of a DNS
-packet.
-
-=head1 METHODS
-
-=head2 new
-
- $header = Net::DNS::Header->new;
-
-C<new> creates a header object appropriate for making a DNS query.
-
-=cut
-
-{
- sub nextid {
- int rand(MAX_ID);
- }
-}
-
-sub new {
- my $class = shift;
-
- my $self = { id => nextid(),
- qr => 0,
- opcode => $Net::DNS::opcodesbyval{0},
- aa => 0,
- tc => 0,
- rd => 1,
- ra => 0,
- ad => 0,
- cd => 0,
- rcode => $Net::DNS::rcodesbyval{0},
- qdcount => 0,
- ancount => 0,
- nscount => 0,
- arcount => 0,
- };
-
- bless $self, $class;
-}
-
-
-=head2 parse
-
- ($header, $offset) = Net::DNS::Header->parse(\$data);
-
-Parses the header record at the start of a DNS packet.
-The argument is a reference to the packet data.
-
-Returns a Net::DNS::Header object and the offset of the next location
-in the packet.
-
-Parsing is aborted if the header object cannot be created (e.g.,
-corrupt or insufficient data).
-
-=cut
-
-use constant PACKED_LENGTH => length pack 'n C2 n4', (0)x7;
-
-sub parse {
- my ($class, $data) = @_;
-
- die 'Exception: incomplete data' if length($$data) < PACKED_LENGTH;
-
- my ($id, $b2, $b3, $qd, $an, $ns, $ar) = unpack('n C2 n4', $$data);
-
- my $opval = ($b2 >> 3) & 0xf;
- my $opcode = $Net::DNS::opcodesbyval{$opval} || $opval;
- my $rval = $b3 & 0xf;
- my $rcode = $Net::DNS::rcodesbyval{$rval} || $rval;
-
- my $self = { id => $id,
- qr => ($b2 >> 7) & 0x1,
- opcode => $opcode,
- aa => ($b2 >> 2) & 0x1,
- tc => ($b2 >> 1) & 0x1,
- rd => $b2 & 0x1,
- ra => ($b3 >> 7) & 0x1,
- ad => ($b3 >> 5) & 0x1,
- cd => ($b3 >> 4) & 0x1,
- rcode => $rcode,
- qdcount => $qd,
- ancount => $an,
- nscount => $ns,
- arcount => $ar
- };
-
- bless $self, $class;
-
- return wantarray ? ($self, PACKED_LENGTH) : $self;
-}
-
-#
-# Some people have reported that Net::DNS dies because AUTOLOAD picks up
-# calls to DESTROY.
-#
-sub DESTROY {}
-
-=head2 print
-
- $header->print;
-
-Prints the header record on the standard output.
-
-=cut
-
-sub print { print &string, "\n"; }
-
-=head2 string
-
- print $header->string;
-
-Returns a string representation of the header object.
-
-=cut
-
-sub string {
- my $self = shift;
- my $retval = "";
-
- $retval .= ";; id = $self->{id}\n";
-
- if ($self->{"opcode"} eq "UPDATE") {
- $retval .= ";; qr = $self->{qr} " .
- "opcode = $self->{opcode} " .
- "rcode = $self->{rcode}\n";
-
- $retval .= ";; zocount = $self->{qdcount} " .
- "prcount = $self->{ancount} " .
- "upcount = $self->{nscount} " .
- "adcount = $self->{arcount}\n";
- }
- else {
- $retval .= ";; qr = $self->{qr} " .
- "opcode = $self->{opcode} " .
- "aa = $self->{aa} " .
- "tc = $self->{tc} " .
- "rd = $self->{rd}\n";
-
- $retval .= ";; ra = $self->{ra} " .
- "ad = $self->{ad} " .
- "cd = $self->{cd} " .
- "rcode = $self->{rcode}\n";
-
- $retval .= ";; qdcount = $self->{qdcount} " .
- "ancount = $self->{ancount} " .
- "nscount = $self->{nscount} " .
- "arcount = $self->{arcount}\n";
- }
-
- return $retval;
-}
-
-=head2 id
-
- print "query id = ", $header->id, "\n";
- $header->id(1234);
-
-Gets or sets the query identification number.
-
-=head2 qr
-
- print "query response flag = ", $header->qr, "\n";
- $header->qr(0);
-
-Gets or sets the query response flag.
-
-=head2 opcode
-
- print "query opcode = ", $header->opcode, "\n";
- $header->opcode("UPDATE");
-
-Gets or sets the query opcode (the purpose of the query).
-
-=head2 aa
-
- print "answer is ", $header->aa ? "" : "non-", "authoritative\n";
- $header->aa(0);
-
-Gets or sets the authoritative answer flag.
-
-=head2 tc
-
- print "packet is ", $header->tc ? "" : "not ", "truncated\n";
- $header->tc(0);
-
-Gets or sets the truncated packet flag.
-
-=head2 rd
-
- print "recursion was ", $header->rd ? "" : "not ", "desired\n";
- $header->rd(0);
-
-Gets or sets the recursion desired flag.
-
-
-=head2 cd
-
- print "checking was ", $header->cd ? "not" : "", "desired\n";
- $header->cd(0);
-
-Gets or sets the checking disabled flag.
-
-
-
-=head2 ra
-
- print "recursion is ", $header->ra ? "" : "not ", "available\n";
- $header->ra(0);
-
-Gets or sets the recursion available flag.
-
-
-=head2 ad
-
- print "The result has ", $header->ad ? "" : "not", "been verified\n"
-
-
-Relevant in DNSSEC context.
-
-(The AD bit is only set on answers where signatures have been
-cryptographically verified or the server is authoritative for the data
-and is allowed to set the bit by policy.)
-
-
-=head2 rcode
-
- print "query response code = ", $header->rcode, "\n";
- $header->rcode("SERVFAIL");
-
-Gets or sets the query response code (the status of the query).
-
-=head2 qdcount, zocount
-
- print "# of question records: ", $header->qdcount, "\n";
- $header->qdcount(2);
-
-Gets or sets the number of records in the question section of the packet.
-In dynamic update packets, this field is known as C<zocount> and refers
-to the number of RRs in the zone section.
-
-=head2 ancount, prcount
-
- print "# of answer records: ", $header->ancount, "\n";
- $header->ancount(5);
-
-Gets or sets the number of records in the answer section of the packet.
-In dynamic update packets, this field is known as C<prcount> and refers
-to the number of RRs in the prerequisite section.
-
-=head2 nscount, upcount
-
- print "# of authority records: ", $header->nscount, "\n";
- $header->nscount(2);
-
-Gets or sets the number of records in the authority section of the packet.
-In dynamic update packets, this field is known as C<upcount> and refers
-to the number of RRs in the update section.
-
-=head2 arcount, adcount
-
- print "# of additional records: ", $header->arcount, "\n";
- $header->arcount(3);
-
-Gets or sets the number of records in the additional section of the packet.
-In dynamic update packets, this field is known as C<adcount>.
-
-=cut
-
-sub zocount { &qdcount; }
-sub prcount { &ancount; }
-sub upcount { &nscount; }
-sub adcount { &arcount; }
-
-
-sub AUTOLOAD {
- my $self = shift;
-
- my $name = $AUTOLOAD;
- $name =~ s/.*://o;
-
- croak "$AUTOLOAD: no such method" unless exists $self->{$name};
-
- return $self->{$name} unless @_;
-
- my $value = shift;
- $self->{$name} = $value;
-}
-
-
-=head2 data
-
- $hdata = $header->data;
-
-Returns the header data in binary format, appropriate for use in a
-DNS query packet.
-
-=cut
-
-sub data {
- my $self = shift;
-
- my $opcode = $Net::DNS::opcodesbyname{ $self->{opcode} };
- my $rcode = $Net::DNS::rcodesbyname{ $self->{rcode} };
-
- my $byte2 = ($self->{qr} ? 0x80 : 0)
- | ($opcode << 3)
- | ($self->{aa} ? 0x04 : 0)
- | ($self->{tc} ? 0x02 : 0)
- | ($self->{rd} ? 0x01 : 0);
-
- my $byte3 = ($self->{ra} ? 0x80 : 0)
- | ($self->{ad} ? 0x20 : 0)
- | ($self->{cd} ? 0x10 : 0)
- | ($rcode || 0);
-
- pack('n C2 n4', $self->{id}, $byte2, $byte3,
- map{$self->{$_} || 0} qw(qdcount ancount nscount arcount) );
-}
-
-=head1 COPYRIGHT
-
-Copyright (c) 1997-2002 Michael Fuhr.
-
-Portions Copyright (c) 2002-2004 Chris Reinhardt.
-
-Portions Copyright (c) 2007 Dick Franks.
-
-All rights reserved. This program is free software; you may redistribute
-it and/or modify it under the same terms as Perl itself.
-
-=head1 SEE ALSO
-
-L<perl(1)>, L<Net::DNS>, L<Net::DNS::Resolver>, L<Net::DNS::Packet>,
-L<Net::DNS::Update>, L<Net::DNS::Question>, L<Net::DNS::RR>,
-RFC 1035 Section 4.1.1
-
-=cut
-
-1;
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/Nameserver.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/Nameserver.pm
deleted file mode 100644
index a0ad2f34f5d..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/Nameserver.pm
+++ /dev/null
@@ -1,703 +0,0 @@
-package Net::DNS::Nameserver;
-#
-# $Id: Nameserver.pm 709 2008-02-06 22:40:42Z olaf $
-#
-
-use Net::DNS;
-use IO::Socket;
-use IO::Socket::INET;
-use IO::Select;
-use Carp qw(cluck);
-
-use strict;
-use vars qw( $VERSION
- $has_inet6
- );
-
-use constant FORCE_INET4 => 0;
-
-use constant DEFAULT_ADDR => 0;
-use constant DEFAULT_PORT => 53;
-
-use constant STATE_ACCEPTED => 1;
-use constant STATE_GOT_LENGTH => 2;
-use constant STATE_SENDING => 3;
-
-$VERSION = (qw$LastChangedRevision: 709 $)[1];
-
-
-
-BEGIN {
- if ( FORCE_INET4 ) {
- $has_inet6 = 0;
- } elsif ( eval {require Socket6;} &&
- # INET6 earlier than V2.01 will not work; sorry.
- eval {require IO::Socket::INET6; IO::Socket::INET6->VERSION("2.01");} ) {
- import Socket6;
- $has_inet6 = 1;
- } else {
- $has_inet6=0;
- }
-}
-
-
-#------------------------------------------------------------------------------
-
-
-#------------------------------------------------------------------------------
-# Constructor.
-#------------------------------------------------------------------------------
-
-sub new {
- my ($class, %self) = @_;
-
- unless ( ref $self{ReplyHandler} ) {
- cluck "No reply handler!";
- return;
- }
-
- # local server addresses must also be accepted by a resolver
- my @LocalAddr = ref $self{LocalAddr} ? @{$self{LocalAddr}} : ($self{LocalAddr});
- my $resolver = Net::DNS::Resolver->new;
- $resolver->force_v4(1) unless $has_inet6;
- $resolver->nameservers(undef);
- my @localaddresses = $resolver->nameservers(@LocalAddr);
-
- my $port = $self{LocalPort} || DEFAULT_PORT;
-
- my @sock_tcp; # All the TCP sockets we will listen to.
- my @sock_udp; # All the UDP sockets we will listen to.
-
- # while we are here, print incomplete lines as they come along.
- local $| = 1 if $self{Verbose};
-
- foreach my $addr ( @localaddresses ? @localaddresses : DEFAULT_ADDR ){
-
- #--------------------------------------------------------------------------
- # Create the TCP socket.
- #--------------------------------------------------------------------------
-
- print "\nCreating TCP socket $addr#$port - " if $self{Verbose};
-
- my $sock_tcp = inet_new(
- LocalAddr => $addr,
- LocalPort => $port,
- Listen => 64,
- Proto => "tcp",
- Reuse => 1,
- );
- if ( $sock_tcp ) {
- push @sock_tcp, $sock_tcp;
- print "done.\n" if $self{Verbose};
- } else {
- cluck "Couldn't create TCP socket: $!";
- }
-
- #--------------------------------------------------------------------------
- # Create the UDP Socket.
- #--------------------------------------------------------------------------
-
- print "Creating UDP socket $addr#$port - " if $self{Verbose};
-
- my $sock_udp = inet_new(
- LocalAddr => $addr,
- LocalPort => $port,
- Proto => "udp",
- );
-
- if ( $sock_udp ) {
- push @sock_udp, $sock_udp;
- print "done.\n" if $self{Verbose};
- } else {
- cluck "Couldn't create UDP socket: $!";
- }
-
- }
-
- #--------------------------------------------------------------------------
- # Create the Select object.
- #--------------------------------------------------------------------------
-
- my $select = $self{select} = IO::Select->new;
-
- $select->add(@sock_tcp);
- $select->add(@sock_udp);
-
- return undef unless $select->count;
-
- #--------------------------------------------------------------------------
- # Return the object.
- #--------------------------------------------------------------------------
-
- my $self = bless \%self, $class;
- return $self;
-}
-
-#------------------------------------------------------------------------------
-# inet_new - Calls the constructor in the correct module for making sockets.
-#------------------------------------------------------------------------------
-
-sub inet_new {
- if ($has_inet6) {
- return IO::Socket::INET6->new(@_);
- } else {
- return IO::Socket::INET->new(@_);
- }
-}
-
-#------------------------------------------------------------------------------
-# make_reply - Make a reply packet.
-#------------------------------------------------------------------------------
-
-sub make_reply {
- my ($self, $query, $peerhost) = @_;
-
- my $reply = Net::DNS::Packet->new(); # create empty reply packet
- $reply->header->qr(1);
-
- my $headermask;
-
- unless ($query) {
- print "ERROR: invalid packet\n" if $self->{"Verbose"};
- $reply->header->rcode("FORMERR");
- return $reply;
- }
-
- if ($query->header->qr()) {
- print "ERROR: invalid packet (qr was set, dropping)\n" if $self->{"Verbose"};
- return;
- }
-
-
- # question section returned to caller
- my @q = $query->question;
- @q=( Net::DNS::Question->new('', 'ANY', 'ANY') ) unless @q;
-
- $reply->push("question", @q);
-
- if ($query->header->opcode eq "QUERY" ||
- $query->header->opcode eq "NS_NOTIFY_OP" #RFC1996
- ) {
- if ($query->header->qdcount == 1) {
- my ($qr) = @q;
- my $qname = $qr->qname;
- my $qtype = $qr->qtype;
- my $qclass = $qr->qclass;
-
- print "query ", $query->header->id,
- ": ($qname, $qclass, $qtype) - " if $self->{"Verbose"};
-
- my ($rcode, $ans, $auth, $add);
-
- if ($query->header->opcode eq "QUERY"){
- ($rcode, $ans, $auth, $add, $headermask) =
- &{$self->{"ReplyHandler"}}($qname, $qclass, $qtype, $peerhost, $query);
- }else{
- $reply->header->rcode("SERVFAIL") unless
- ( ref $self->{"NotifyHandler"} eq "CODE");
- ($rcode, $ans, $auth, $add, $headermask) =
- &{$self->{"NotifyHandler"}}($qname, $qclass, $qtype, $peerhost, $query);
- }
- print "$rcode\n" if $self->{"Verbose"};
-
- $reply->header->rcode($rcode);
-
- $reply->push("answer", @$ans) if $ans;
- $reply->push("authority", @$auth) if $auth;
- $reply->push("additional", @$add) if $add;
- } else {
- print "ERROR: qdcount ", $query->header->qdcount,
- "unsupported\n" if $self->{"Verbose"};
- $reply->header->rcode("FORMERR");
- }
- } else {
- print "ERROR: opcode ", $query->header->opcode, " unsupported\n"
- if $self->{"Verbose"};
- $reply->header->rcode("FORMERR");
- }
-
-
-
- if (!defined ($headermask)) {
- $reply->header->ra(1);
- $reply->header->ad(0);
- } else {
- $reply->header->aa(1) if $headermask->{'aa'};
- $reply->header->ra(1) if $headermask->{'ra'};
- $reply->header->ad(1) if $headermask->{'ad'};
- }
-
-
- $reply->header->cd($query->header->cd);
- $reply->header->rd($query->header->rd);
- $reply->header->id($query->header->id);
-
- $reply->header->print if $self->{"Verbose"} && defined $headermask;
-
- return $reply;
-}
-
-#------------------------------------------------------------------------------
-# readfromtcp - read from a TCP client
-#------------------------------------------------------------------------------
-
-sub readfromtcp {
- my ($self, $sock) = @_;
- return -1 unless defined $self->{"_tcp"}{$sock};
- my $peer = $self->{"_tcp"}{$sock}{"peer"};
- my $charsread = $sock->sysread(
- $self->{"_tcp"}{$sock}{"inbuffer"},
- 16384);
- $self->{"_tcp"}{$sock}{"timeout"} = time()+120; # Reset idle timer
- print "Received $charsread octets from $peer\n" if $self->{"Verbose"};
- if ($charsread == 0) { # 0 octets means socket has closed
- print "Connection to $peer closed or lost.\n" if $self->{"Verbose"};
- $self->{"select"}->remove($sock);
- $sock->close();
- delete $self->{"_tcp"}{$sock};
- return $charsread;
- }
- return $charsread;
-}
-
-#------------------------------------------------------------------------------
-# tcp_connection - Handle a TCP connection.
-#------------------------------------------------------------------------------
-
-sub tcp_connection {
- my ($self, $sock) = @_;
-
- if (not $self->{"_tcp"}{$sock}) {
- # We go here if we are called with a listener socket.
- my $client = $sock->accept;
- if (not defined $client) {
- print "TCP connection closed by peer before we could accept it.\n" if $self->{"Verbose"};
- return 0;
- }
- my $peerport= $client->peerport;
- my $peerhost = $client->peerhost;
-
- print "TCP connection from $peerhost:$peerport\n" if $self->{"Verbose"};
- $client->blocking(0);
- $self->{"_tcp"}{$client}{"peer"} = "tcp:".$peerhost.":".$peerport;
- $self->{"_tcp"}{$client}{"state"} = STATE_ACCEPTED;
- $self->{"_tcp"}{$client}{"socket"} = $client;
- $self->{"_tcp"}{$client}{"timeout"} = time()+120;
- $self->{"select"}->add($client);
- # After we accepted we will look at the socket again
- # to see if there is any data there. ---Olaf
- $self->loop_once(0);
- } else {
- # We go here if we are called with a client socket
- my $peer = $self->{"_tcp"}{$sock}{"peer"};
-
- if ($self->{"_tcp"}{$sock}{"state"} == STATE_ACCEPTED) {
- if (not $self->{"_tcp"}{$sock}{"inbuffer"} =~ s/^(..)//s) {
- return; # Still not 2 octets ready
- }
- my $msglen = unpack("n", $1);
- print "Removed 2 octets from the input buffer from $peer.\n".
- "$peer said his query contains $msglen octets.\n"
- if $self->{"Verbose"};
- $self->{"_tcp"}{$sock}{"state"} = STATE_GOT_LENGTH;
- $self->{"_tcp"}{$sock}{"querylength"} = $msglen;
- }
- # Not elsif, because we might already have all the data
- if ($self->{"_tcp"}{$sock}{"state"} == STATE_GOT_LENGTH) {
- # return if not all data has been received yet.
- return if $self->{"_tcp"}{$sock}{"querylength"} > length $self->{"_tcp"}{$sock}{"inbuffer"};
-
- my $qbuf = substr($self->{"_tcp"}{$sock}{"inbuffer"}, 0, $self->{"_tcp"}{$sock}{"querylength"});
- substr($self->{"_tcp"}{$sock}{"inbuffer"}, 0, $self->{"_tcp"}{$sock}{"querylength"}) = "";
- my $query = Net::DNS::Packet->new(\$qbuf);
- my $reply = $self->make_reply($query, $sock->peerhost);
- if (not defined $reply) {
- print "I couldn't create a reply for $peer. Closing socket.\n"
- if $self->{"Verbose"};
- $self->{"select"}->remove($sock);
- $sock->close();
- delete $self->{"_tcp"}{$sock};
- return;
- }
- my $reply_data = $reply->data;
- my $len = length $reply_data;
- $self->{"_tcp"}{$sock}{"outbuffer"} = pack("n", $len) . $reply_data;
- print "Queued ",
- length $self->{"_tcp"}{$sock}{"outbuffer"},
- " octets to $peer\n"
- if $self->{"Verbose"};
- # We are done.
- $self->{"_tcp"}{$sock}{"state"} = STATE_SENDING;
- }
- }
-}
-
-#------------------------------------------------------------------------------
-# udp_connection - Handle a UDP connection.
-#------------------------------------------------------------------------------
-
-sub udp_connection {
- my ($self, $sock) = @_;
-
- my $buf = "";
-
- $sock->recv($buf, &Net::DNS::PACKETSZ);
- my ($peerhost,$peerport) = ($sock->peerhost, $sock->peerport);
-
- print "UDP connection from $peerhost:$peerport\n" if $self->{"Verbose"};
-
- my $query = Net::DNS::Packet->new(\$buf);
-
- my $reply = $self->make_reply($query, $peerhost) || return;
- my $reply_data = $reply->data;
-
- local $| = 1 if $self->{"Verbose"};
- print "Writing response - " if $self->{"Verbose"};
-
- if ($sock->send($reply_data)) { #
- print "done\n" if $self->{"Verbose"};
- }
- else {
- print "failed to send reply: $!\n" if $self->{"Verbose"};
- }
- }
-
-
-sub get_open_tcp {
- my $self=shift;
- return keys %{$self->{"_tcp"}};
-}
-
-
-#------------------------------------------------------------------------------
-# loop_once - Just check "once" on sockets already set up
-#------------------------------------------------------------------------------
-
-# This function might not actually return immediately. If an AXFR request is
-# coming in which will generate a huge reply, we will not relinquish control
-# until our outbuffers are empty.
-
-#
-# NB this method may be subject to change and is therefore left 'undocumented'
-#
-
-sub loop_once {
- my ($self, $timeout) = @_;
- $timeout=0 unless defined($timeout);
- print ";loop_once called with $timeout \n" if $self->{"Verbose"} >4;
- foreach my $sock (keys %{$self->{"_tcp"}}) {
- $timeout = 0.1 if $self->{"_tcp"}{$sock}{"outbuffer"};
- }
- my @ready = $self->{"select"}->can_read($timeout);
-
- foreach my $sock (@ready) {
- my $protonum = $sock->protocol;
- # This is a weird and nasty hack. Although not incorrect,
- # I just don't know why ->protocol won't tell me the protocol
- # on a connected socket. --robert
- $protonum = getprotobyname('tcp') if not defined $protonum and $self->{"_tcp"}{$sock};
-
- my $proto = getprotobynumber($protonum);
- if (!$proto) {
- print "ERROR: connection with unknown protocol\n"
- if $self->{"Verbose"};
- } elsif (lc($proto) eq "tcp") {
-
- $self->readfromtcp($sock) &&
- $self->tcp_connection($sock);
- } elsif (lc($proto) eq "udp") {
- $self->udp_connection($sock);
- } else {
- print "ERROR: connection with unsupported protocol $proto\n"
- if $self->{"Verbose"};
- }
- }
- my $now = time();
- # Lets check if any of our TCP clients has pending actions.
- # (outbuffer, timeout)
- foreach my $s (keys %{$self->{"_tcp"}}) {
- my $sock = $self->{"_tcp"}{$s}{"socket"};
- if ($self->{"_tcp"}{$s}{"outbuffer"}) {
- # If we have buffered output, then send as much as the OS will accept
- # and wait with the rest
- my $len = length $self->{"_tcp"}{$s}{"outbuffer"};
- my $charssent = $sock->syswrite($self->{"_tcp"}{$s}{"outbuffer"});
- print "Sent $charssent of $len octets to ",$self->{"_tcp"}{$s}{"peer"},".\n"
- if $self->{"Verbose"};
- substr($self->{"_tcp"}{$s}{"outbuffer"}, 0, $charssent) = "";
- if (length $self->{"_tcp"}{$s}{"outbuffer"} == 0) {
- delete $self->{"_tcp"}{$s}{"outbuffer"};
- $self->{"_tcp"}{$s}{"state"} = STATE_ACCEPTED;
- if (length $self->{"_tcp"}{$s}{"inbuffer"} >= 2) {
- # See if the client has send us enough data to process the
- # next query.
- # We do this here, because we only want to process (and buffer!!)
- # a single query at a time, per client. If we allowed a STATE_SENDING
- # client to have new requests processed. We could be easilier
- # victims of DoS (client sending lots of queries and never reading
- # from it's socket).
- # Note that this does not disable serialisation on part of the
- # client. The split second it should take for us to lookip the
- # next query, is likely faster than the time it takes to
- # send the response... well, unless it's a lot of tiny queries,
- # in which case we will be generating an entire TCP packet per
- # reply. --robert
- $self->tcp_connection($self->{"_tcp"}{"socket"});
- }
- }
- $self->{"_tcp"}{$s}{"timeout"} = time()+120;
- } else {
- # Get rid of idle clients.
- my $timeout = $self->{"_tcp"}{$s}{"timeout"};
- if ($timeout - $now < 0) {
- print $self->{"_tcp"}{$s}{"peer"}," has been idle for too long and will be disconnected.\n"
- if $self->{"Verbose"};
- $self->{"select"}->remove($sock);
- $sock->close();
- delete $self->{"_tcp"}{$s};
- }
- }
- }
-}
-
-#------------------------------------------------------------------------------
-# main_loop - Main nameserver loop.
-#------------------------------------------------------------------------------
-
-sub main_loop {
- my $self = shift;
-
- while (1) {
- print "Waiting for connections...\n" if $self->{"Verbose"};
- # You really need an argument otherwise you'll be burning
- # CPU.
- $self->loop_once(10);
- }
-}
-
-1;
-
-__END__
-
-=head1 NAME
-
-Net::DNS::Nameserver - DNS server class
-
-=head1 SYNOPSIS
-
-C<use Net::DNS::Nameserver;>
-
-=head1 DESCRIPTION
-
-Instances of the C<Net::DNS::Nameserver> class represent DNS server
-objects. See L</EXAMPLE> for an example.
-
-=head1 METHODS
-
-=head2 new
-
- my $ns = Net::DNS::Nameserver->new(
- LocalAddr => "10.1.2.3",
- LocalPort => "5353",
- ReplyHandler => \&reply_handler,
- Verbose => 1
- );
-
-
-
- my $ns = Net::DNS::Nameserver->new(
- LocalAddr => ['::1' , '127.0.0.1' ],
- LocalPort => "5353",
- ReplyHandler => \&reply_handler,
- Verbose => 1
- );
-
-Creates a nameserver object. Attributes are:
-
- LocalAddr IP address on which to listen. Defaults to INADDR_ANY.
- LocalPort Port on which to listen. Defaults to 53.
- ReplyHandler Reference to reply-handling
- subroutine Required.
- NotifyHandler Reference to reply-handling
- subroutine for queries with
- opdcode NS_NOTIFY (RFC1996)
- Verbose Print info about received
- queries. Defaults to 0 (off).
-
-
-The LocalAddr attribute may alternatively be specified as a list of IP
-addresses to listen to.
-
-If IO::Socket::INET6 and Socket6 are available on the system you can
-also list IPv6 addresses and the default is '0' (listen on all interfaces on
-IPv6 and IPv4);
-
-
-The ReplyHandler subroutine is passed the query name, query class,
-query type and optionally an argument containing the peerhost the
-incoming query. It must return the response code and references to the
-answer, authority, and additional sections of the response. Common
-response codes are:
-
- NOERROR No error
- FORMERR Format error
- SERVFAIL Server failure
- NXDOMAIN Non-existent domain (name doesn't exist)
- NOTIMP Not implemented
- REFUSED Query refused
-
-For advanced usage it may also contain a headermaks containing an
-hashref with the settings for the C<aa>, C<ra>, and C<ad>
-header bits. The argument is of the form
-C<< { ad => 1, aa => 0, ra => 1 } >>.
-
-
-See RFC 1035 and the IANA dns-parameters file for more information:
-
- ftp://ftp.rfc-editor.org/in-notes/rfc1035.txt
- http://www.isi.edu/in-notes/iana/assignments/dns-parameters
-
-The nameserver will listen for both UDP and TCP connections. On
-Unix-like systems, the program will probably have to run as root
-to listen on the default port, 53. A non-privileged user should
-be able to listen on ports 1024 and higher.
-
-Returns a Net::DNS::Nameserver object, or undef if the object
-couldn't be created.
-
-See L</EXAMPLE> for an example.
-
-=head2 main_loop
-
- $ns->main_loop;
-
-Start accepting queries. Calling main_loop never returns.
-
-=cut
-
-#####
-#
-# The functionality might change. Left "undocumented" for now.
-#
-=head2 loop_once
-
- $ns->loop_once( [TIMEOUT_IN_SECONDS] );
-
-Start accepting queries, but returns. If called without a parameter,
-the call will not return until a request has been received (and
-replied to). If called with a number, that number specifies how many
-seconds (even fractional) to maximum wait before returning. If called
-with 0 it will return immediately unless there's something to do.
-
-Handling a request and replying obviously depends on the speed of
-ReplyHandler. Assuming ReplyHandler is super fast, loop_once should spend
-just a fraction of a second, if called with a timeout value of 0 seconds.
-One exception is when an AXFR has requested a huge amount of data that
-the OS is not ready to receive in full. In that case, it will keep
-running through a loop (while servicing new requests) until the reply
-has been sent.
-
-In case loop_once accepted a TCP connection it will immediatly check
-if there is data to be read from the socket. If not it will return and
-you will have to call loop_once() again to check if there is any data
-waiting on the socket to be processed. In most cases you will have to
-count on calling "loop_once" twice.
-
-A code fragment like:
- $ns->loop_once(10);
- while( $ns->get_open_tcp() ){
- $ns->loop_once(0);
- }
-
-Would wait for 10 seconds for the initial connection and would then
-process all TCP sockets until none is left.
-
-=head2 get_open_tcp
-
-In scalar context returns the number of TCP connections for which state
-is maintained. In array context it returns IO::Socket objects, these could
-be useful for troubleshooting but be careful using them.
-
-=head1 EXAMPLE
-
-The following example will listen on port 5353 and respond to all queries
-for A records with the IP address 10.1.2.3. All other queries will be
-answered with NXDOMAIN. Authority and additional sections are left empty.
-The $peerhost variable catches the IP address of the peer host, so that
-additional filtering on its basis may be applied.
-
- #!/usr/bin/perl
-
- use Net::DNS::Nameserver;
- use strict;
- use warnings;
-
- sub reply_handler {
- my ($qname, $qclass, $qtype, $peerhost,$query) = @_;
- my ($rcode, @ans, @auth, @add);
-
- print "Received query from $peerhost\n";
- $query->print;
-
-
- if ($qtype eq "A" && $qname eq "foo.example.com" ) {
- my ($ttl, $rdata) = (3600, "10.1.2.3");
- push @ans, Net::DNS::RR->new("$qname $ttl $qclass $qtype $rdata");
- $rcode = "NOERROR";
- }elsif( $qname eq "foo.example.com" ) {
- $rcode = "NOERROR";
-
- }else{
- $rcode = "NXDOMAIN";
- }
-
-
- # mark the answer as authoritive (by setting the 'aa' flag
- return ($rcode, \@ans, \@auth, \@add, { aa => 1 });
- }
-
- my $ns = Net::DNS::Nameserver->new(
- LocalPort => 5353,
- ReplyHandler => \&reply_handler,
- Verbose => 1,
- ) || die "couldn't create nameserver object\n";
-
- $ns->main_loop;
-
-=head1 BUGS
-
-Limitations in perl 5.8.6 makes it impossible to guarantee that
-replies to UDP queries from Net::DNS::Nameserver are sent from the
-IP-address they were received on. This is a problem for machines with
-multiple IP-addresses and causes violation of RFC2181 section 4.
-Thus a UDP socket created listening to INADDR_ANY (all available
-IP-addresses) will reply not necessarily with the source address being
-the one to which the request was sent, but rather with the address that
-the operating system choses. This is also often called "the closest
-address". This should really only be a problem on a server which has
-more than one IP-address (besides localhost - any experience with IPv6
-complications here, would be nice). If this is a problem for you, a
-work-around would be to not listen to INADDR_ANY but to specify each
-address that you want this module to listen on. A seperate set of
-sockets will then be created for each IP-address.
-
-=head1 COPYRIGHT
-
-Copyright (c) 1997-2002 Michael Fuhr.
-
-Portions Copyright (c) 2002-2004 Chris Reinhardt.
-
-Portions Copyright (c) 2005-2007 O.M, Kolkman, RIPE NCC.
-
-Portions Copyright (c) 2005 Robert Martin-Legene.
-
-All rights reserved. This program is free software; you may redistribute
-it and/or modify it under the same terms as Perl itself.
-
-=head1 SEE ALSO
-
-L<perl(1)>, L<Net::DNS>, L<Net::DNS::Resolver>, L<Net::DNS::Packet>,
-L<Net::DNS::Update>, L<Net::DNS::Header>, L<Net::DNS::Question>,
-L<Net::DNS::RR>, RFC 1035
-
-=cut
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/Packet.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/Packet.pm
deleted file mode 100644
index 9aabcac01e4..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/Packet.pm
+++ /dev/null
@@ -1,749 +0,0 @@
-package Net::DNS::Packet;
-#
-# $Id: Packet.pm 704 2008-02-06 21:30:59Z olaf $
-#
-use strict;
-
-BEGIN {
- eval { require bytes; }
-}
-
-use vars qw(@ISA @EXPORT_OK $VERSION $AUTOLOAD);
-
-use Carp;
-use Net::DNS ;
-use Net::DNS::Question;
-use Net::DNS::RR;
-
-
-
-require Exporter;
-@ISA = qw(Exporter);
-@EXPORT_OK = qw(dn_expand);
-
-
-$VERSION = (qw$LastChangedRevision: 704 $)[1];
-
-
-
-=head1 NAME
-
-Net::DNS::Packet - DNS packet object class
-
-=head1 SYNOPSIS
-
-C<use Net::DNS::Packet;>
-
-=head1 DESCRIPTION
-
-A C<Net::DNS::Packet> object represents a DNS packet.
-
-=head1 METHODS
-
-=head2 new
-
- $packet = Net::DNS::Packet->new("example.com");
- $packet = Net::DNS::Packet->new("example.com", "MX", "IN");
-
- $packet = Net::DNS::Packet->new(\$data);
- $packet = Net::DNS::Packet->new(\$data, 1); # set debugging
-
- ($packet, $err) = Net::DNS::Packet->new(\$data);
-
- $packet = Net::DNS::Packet->new();
-
-If passed a domain, type, and class, C<new> creates a packet
-object appropriate for making a DNS query for the requested
-information. The type and class can be omitted; they default
-to A and IN.
-
-If passed a reference to a scalar containing DNS packet data,
-C<new> creates a packet object from that data. A second argument
-can be passed to turn on debugging output for packet parsing.
-
-If called in array context, returns a packet object and an
-error string. The error string will only be defined if the
-packet object is undefined (i.e., couldn't be created).
-
-Returns B<undef> if unable to create a packet object (e.g., if
-the packet data is truncated).
-
-If called with an empty argument list, C<new> creates an empty packet.
-
-=cut
-
-sub new {
- my $class = shift;
- my ($data) = @_;
- return $class->parse(@_) if ref $data;
-
- my %self = ( header => Net::DNS::Header->new,
- question => [],
- answer => [],
- authority => [],
- additional => [] );
-
- push @{$self{question}}, Net::DNS::Question->new(@_) if @_;
-
- bless \%self, $class;
-}
-
-
-
-sub parse {
- my $class = shift;
- my $data = shift;
- my $debug = shift || 0;
-
- my %self = ( question => [],
- answer => [],
- authority => [],
- additional => [],
- answersize => length $$data,
- buffer => $data );
-
- my $self = eval {
- # Parse header section
- my ($header, $offset) = Net::DNS::Header->parse($data);
- $self{header} = $header;
-
- # Parse question/zone section
- for ( 1 .. $header->qdcount ) {
- my $qd;
- ($qd, $offset) = Net::DNS::Question->parse($data, $offset);
- push(@{$self{question}}, $qd);
- }
-
- # Retain offset for on-demand parse of remaining data
- $self{offset} = $offset;
-
- bless \%self, $class;
- };
-
- ($self || die $@)->print if $debug;
-
- return wantarray ? ($self, $@) : $self;
-}
-
-
-
-=head2 data
-
- $data = $packet->data;
-
-Returns the packet data in binary format, suitable for sending to
-a nameserver.
-
-=cut
-
-sub data {
- my $self = shift;
- my $data = '';
- my $header = $self->{header};
-
- # Default question for empty packet
- $self->push('question', Net::DNS::Question->new('','ANY','ANY'))
- unless @{$self->{question}};
-
- #----------------------------------------------------------------------
- # Set record counts in packet header
- #----------------------------------------------------------------------
- $header->qdcount( scalar @{$self->{question}} );
- $header->ancount( scalar @{$self->{answer}} );
- $header->nscount( scalar @{$self->{authority}} );
- $header->arcount( scalar @{$self->{additional}} );
-
- #----------------------------------------------------------------------
- # Get the data for each section in the packet
- #----------------------------------------------------------------------
- $self->{compnames} = {};
- foreach my $component ( $header,
- @{$self->{question}},
- @{$self->{answer}},
- @{$self->{authority}},
- @{$self->{additional}} ) {
- $data .= $component->data($self, length $data);
- }
-
- return $data;
-}
-
-
-=head2 header
-
- $header = $packet->header;
-
-Returns a C<Net::DNS::Header> object representing the header section
-of the packet.
-
-=cut
-
-sub header {
- return shift->{header};
-}
-
-=head2 question, zone
-
- @question = $packet->question;
-
-Returns a list of C<Net::DNS::Question> objects representing the
-question section of the packet.
-
-In dynamic update packets, this section is known as C<zone> and
-specifies the zone to be updated.
-
-=cut
-
-sub question {
- return @{shift->{question}};
-}
-
-sub zone { &question }
-
-=head2 answer, pre, prerequisite
-
- @answer = $packet->answer;
-
-Returns a list of C<Net::DNS::RR> objects representing the answer
-section of the packet.
-
-In dynamic update packets, this section is known as C<pre> or
-C<prerequisite> and specifies the RRs or RRsets which must or
-must not preexist.
-
-=cut
-
-sub answer {
- my @rr = eval { &_answer };
- carp "$@ caught" if $@;
- return @rr;
-}
-
-sub _answer {
- my ($self) = @_;
-
- my @rr = @{$self->{answer}};
- return @rr if @rr; # return if already parsed
-
- my $data = $self->{buffer}; # parse answer data
- my $offset = $self->{offset} || return;
- undef $self->{offset};
- my $ancount = $self->{header}->ancount;
- my $rr;
- while ( $ancount-- ) {
- ($rr, $offset) = Net::DNS::RR->parse($data, $offset);
- push(@rr, $rr);
- }
- $self->{offset} = $offset; # index next section
- @{$self->{answer}} = @rr;
-}
-
-sub pre { &answer }
-sub prerequisite { &answer }
-
-=head2 authority, update
-
- @authority = $packet->authority;
-
-Returns a list of C<Net::DNS::RR> objects representing the authority
-section of the packet.
-
-In dynamic update packets, this section is known as C<update> and
-specifies the RRs or RRsets to be added or deleted.
-
-=cut
-
-sub authority {
- my @rr = eval { &_authority };
- carp "$@ caught" if $@;
- return @rr;
-}
-
-sub _authority {
- my ($self) = @_;
-
- my @rr = @{$self->{authority}};
- return @rr if @rr; # return if already parsed
-
- &_answer unless @{$self->{answer}}; # parse answer data
-
- my $data = $self->{buffer}; # parse authority data
- my $offset = $self->{offset} || return;
- undef $self->{offset};
- my $nscount = $self->{header}->nscount;
- my $rr;
- while ( $nscount-- ) {
- ($rr, $offset) = Net::DNS::RR->parse($data, $offset);
- push(@rr, $rr);
- }
- $self->{offset} = $offset; # index next section
- @{$self->{authority}} = @rr;
-}
-
-sub update { &authority }
-
-=head2 additional
-
- @additional = $packet->additional;
-
-Returns a list of C<Net::DNS::RR> objects representing the additional
-section of the packet.
-
-=cut
-
-sub additional {
- my @rr = eval { &_additional };
- carp "$@ caught" if $@;
- return @rr;
-}
-
-sub _additional {
- my ($self) = @_;
-
- my @rr = @{$self->{additional}};
- return @rr if @rr; # return if already parsed
-
- &_authority unless @{$self->{authority}}; # parse authority data
-
- my $data = $self->{buffer}; # parse additional data
- undef $self->{buffer}; # discard raw data after use
- my $offset = $self->{offset} || return;
- undef $self->{offset};
- my $arcount = $self->{header}->arcount;
- my $rr;
- while ( $arcount-- ) {
- ($rr, $offset) = Net::DNS::RR->parse($data, $offset);
- push(@rr, $rr);
- }
- @{$self->{additional}} = @rr;
-}
-
-
-=head2 print
-
- $packet->print;
-
-Prints the packet data on the standard output in an ASCII format
-similar to that used in DNS zone files.
-
-=cut
-
-sub print { print &string; }
-
-=head2 string
-
- print $packet->string;
-
-Returns a string representation of the packet.
-
-=cut
-
-sub string {
- my $self = shift;
-
- my $header = $self->{header};
- my $update = $header->opcode eq 'UPDATE';
-
- my $server = $self->{answerfrom};
- my $string = $server ? ";; Answer received from $server ($self->{answersize} bytes)\n" : "";
-
- $string .= ";; HEADER SECTION\n".$header->string;
-
- my $question = $update ? 'ZONE' : 'QUESTION';
- my @question = map{$_->string} $self->question;
- my $qdcount = @question;
- my $qds = $qdcount != 1 ? 's' : '';
- $string .= join "\n;; ", "\n;; $question SECTION ($qdcount record$qds)", @question;
-
- my $answer = $update ? 'PREREQUISITE' : 'ANSWER';
- my @answer = map{$_->string} $self->answer;
- my $ancount = @answer;
- my $ans = $ancount != 1 ? 's' : '';
- $string .= join "\n", "\n\n;; $answer SECTION ($ancount record$ans)", @answer;
-
- my $authority = $update ? 'UPDATE' : 'AUTHORITY';
- my @authority = map{$_->string} $self->authority;
- my $nscount = @authority;
- my $nss = $nscount != 1 ? 's' : '';
- $string .= join "\n", "\n\n;; $authority SECTION ($nscount record$nss)", @authority;
-
- my @additional = map{$_->string} $self->additional;
- my $arcount = @additional;
- my $ars = $arcount != 1 ? 's' : '';
- $string .= join "\n", "\n\n;; ADDITIONAL SECTION ($arcount record$ars)", @additional;
-
- return $string."\n\n";
-}
-
-=head2 answerfrom
-
- print "packet received from ", $packet->answerfrom, "\n";
-
-Returns the IP address from which we received this packet. User-created
-packets will return undef for this method.
-
-=cut
-
-sub answerfrom {
- my $self = shift;
-
- return $self->{answerfrom} = shift if @_;
-
- return $self->{answerfrom};
-}
-
-=head2 answersize
-
- print "packet size: ", $packet->answersize, " bytes\n";
-
-Returns the size of the packet in bytes as it was received from a
-nameserver. User-created packets will return undef for this method
-(use C<< length $packet->data >> instead).
-
-=cut
-
-sub answersize {
- return shift->{answersize};
-}
-
-=head2 push
-
- $ancount = $packet->push(pre => $rr);
- $nscount = $packet->push(update => $rr);
- $arcount = $packet->push(additional => $rr);
-
- $nscount = $packet->push(update => $rr1, $rr2, $rr3);
- $nscount = $packet->push(update => @rr);
-
-Adds RRs to the specified section of the packet.
-
-Returns the number of resource records in the specified section.
-
-
-=cut
-
-sub push {
- my $self = shift;
- my $section = lc shift || '';
- my @rr = map{ref $_ ? $_ : ()} @_;
-
- my $hdr = $self->{header};
- for ( $section ) {
- return $hdr->qdcount(push(@{$self->{question}}, @rr)) if /^question/;
-
- if ( $hdr->opcode eq 'UPDATE' ) {
- my ($zone) = $self->zone;
- my $zclass = $zone->zclass;
- foreach ( @rr ) {
- $_->class($zclass) unless $_->class =~ /ANY|NONE/;
- }
- }
-
- return $hdr->ancount(push(@{$self->{answer}}, @rr)) if /^ans|^pre/;
- return $hdr->nscount(push(@{$self->{authority}}, @rr)) if /^auth|^upd/;
- return $hdr->adcount(push(@{$self->{additional}}, @rr)) if /^add/;
- }
-
- carp qq(invalid section "$section");
- return undef; # undefined record count
-}
-
-
-=head2 unique_push
-
- $ancount = $packet->unique_push(pre => $rr);
- $nscount = $packet->unique_push(update => $rr);
- $arcount = $packet->unique_push(additional => $rr);
-
- $nscount = $packet->unique_push(update => $rr1, $rr2, $rr3);
- $nscount = $packet->unique_push(update => @rr);
-
-Adds RRs to the specified section of the packet provided that
-the RRs do not already exist in the packet.
-
-Returns the number of resource records in the specified section.
-
-=cut
-
-sub unique_push {
- my $self = shift;
- my $section = shift;
- my @rr = map{ref $_ ? $_ : ()} @_;
-
- my @unique = map{$self->{seen}->{ (lc $_->name) . $_->class . $_->type . $_->rdatastr }++ ? () : $_} @rr;
-
- return $self->push($section, @unique);
-}
-
-=head2 safe_push
-
-A deprecated name for C<unique_push()>.
-
-=cut
-
-sub safe_push {
- carp('safe_push() is deprecated, use unique_push() instead,');
- &unique_push;
-}
-
-
-=head2 pop
-
- my $rr = $packet->pop("pre");
- my $rr = $packet->pop("update");
- my $rr = $packet->pop("additional");
- my $rr = $packet->pop("question");
-
-Removes RRs from the specified section of the packet.
-
-=cut
-
-sub pop {
- my $self = shift;
- my $section = lc shift || '';
-
- for ( $section ) {
- return pop(@{$self->{answer}}) if /^ans|^pre/;
- return pop(@{$self->{question}}) if /^question/;
-
- $self->additional if $self->{buffer}; # parse remaining data
-
- return pop(@{$self->{authority}}) if /^auth|^upd/;
- return pop(@{$self->{additional}}) if /^add/;
- }
-
- carp qq(invalid section "$section");
- return undef;
-}
-
-
-=head2 dn_comp
-
- $compname = $packet->dn_comp("foo.example.com", $offset);
-
-Returns a domain name compressed for a particular packet object, to
-be stored beginning at the given offset within the packet data. The
-name will be added to a running list of compressed domain names for
-future use.
-
-=cut
-
-sub dn_comp {
- my ($self, $name, $offset) = @_;
- # The Exporter module does not seem to catch this baby...
- my @names=Net::DNS::name2labels($name);
- my $namehash = $self->{compnames};
- my $compname='';
-
- while (@names) {
- my $dname = join('.', @names);
-
- if ( my $pointer = $namehash->{$dname} ) {
- $compname .= pack('n', 0xc000 | $pointer);
- last;
- }
- $namehash->{$dname} = $offset;
-
- my $label = shift @names;
- my $length = length $label || next; # skip if null
- if ( $length > 63 ) {
- $length = 63;
- $label = substr($label, 0, $length);
- carp "\n$label...\ntruncated to $length octets (RFC1035 2.3.1)";
- }
- $compname .= pack('C a*', $length, $label);
- $offset += $length + 1;
- }
-
- $compname .= pack('C', 0) unless @names;
-
- return $compname;
-}
-
-=head2 dn_expand
-
- use Net::DNS::Packet qw(dn_expand);
- ($name, $nextoffset) = dn_expand(\$data, $offset);
-
- ($name, $nextoffset) = Net::DNS::Packet::dn_expand(\$data, $offset);
-
-Expands the domain name stored at a particular location in a DNS
-packet. The first argument is a reference to a scalar containing
-the packet data. The second argument is the offset within the
-packet where the (possibly compressed) domain name is stored.
-
-Returns the domain name and the offset of the next location in the
-packet.
-
-Returns B<(undef)> if the domain name couldn't be expanded.
-
-=cut
-# '
-
-# This is very hot code, so we try to keep things fast. This makes for
-# odd style sometimes.
-
-sub dn_expand {
-#FYI my ($packet, $offset) = @_;
- return dn_expand_XS(@_) if $Net::DNS::HAVE_XS;
-# warn "USING PURE PERL dn_expand()\n";
- return dn_expand_PP(@_, {} ); # $packet, $offset, anonymous hash
-}
-
-sub dn_expand_PP {
- my ($packet, $offset, $visited) = @_;
- my $packetlen = length $$packet;
- my $name = '';
-
- while ( $offset < $packetlen ) {
- unless ( my $length = unpack("\@$offset C", $$packet) ) {
- $name =~ s/\.$//o;
- return ($name, ++$offset);
-
- } elsif ( ($length & 0xc0) == 0xc0 ) { # pointer
- my $point = 0x3fff & unpack("\@$offset n", $$packet);
- die 'Exception: unbounded name expansion' if $visited->{$point}++;
-
- my ($suffix) = dn_expand_PP($packet, $point, $visited);
-
- return ($name.$suffix, $offset+2) if defined $suffix;
-
- } else {
- my $element = substr($$packet, ++$offset, $length);
- $name .= Net::DNS::wire2presentation($element).'.';
- $offset += $length;
- }
- }
- return undef;
-}
-
-=head2 sign_tsig
-
- $key_name = "tsig-key";
- $key = "awwLOtRfpGE+rRKF2+DEiw==";
-
- $update = Net::DNS::Update->new("example.com");
- $update->push("update", rr_add("foo.example.com A 10.1.2.3"));
-
- $update->sign_tsig($key_name, $key);
-
- $response = $res->send($update);
-
-Signs a packet with a TSIG resource record (see RFC 2845). Uses the
-following defaults:
-
- algorithm = HMAC-MD5.SIG-ALG.REG.INT
- time_signed = current time
- fudge = 300 seconds
-
-If you wish to customize the TSIG record, you'll have to create it
-yourself and call the appropriate Net::DNS::RR::TSIG methods. The
-following example creates a TSIG record and sets the fudge to 60
-seconds:
-
- $key_name = "tsig-key";
- $key = "awwLOtRfpGE+rRKF2+DEiw==";
-
- $tsig = Net::DNS::RR->new("$key_name TSIG $key");
- $tsig->fudge(60);
-
- $query = Net::DNS::Packet->new("www.example.com");
- $query->sign_tsig($tsig);
-
- $response = $res->send($query);
-
-You shouldn't modify a packet after signing it; otherwise authentication
-will probably fail.
-
-=cut
-
-sub sign_tsig {
- my $self = shift;
- my $tsig = shift || return undef;
-
- unless ( ref $tsig && ($tsig->type eq "TSIG") ) {
- my $key = shift || return undef;
- $tsig = Net::DNS::RR->new("$tsig TSIG $key");
- }
-
- $self->push('additional', $tsig) if $tsig;
- return $tsig;
-}
-
-
-
-=head2 sign_sig0
-
-SIG0 support is provided through the Net::DNS::RR::SIG class. This class is not part
-of the default Net::DNS distribution but resides in the Net::DNS::SEC distribution.
-
- $update = Net::DNS::Update->new("example.com");
- $update->push("update", rr_add("foo.example.com A 10.1.2.3"));
- $update->sign_sig0("Kexample.com+003+25317.private");
-
-
-SIG0 support is experimental see Net::DNS::RR::SIG for details.
-
-The method will call C<Carp::croak()> if Net::DNS::RR::SIG cannot be found.
-
-
-=cut
-
-sub sign_sig0 {
- my $self = shift;
- my $arg = shift || return undef;
- my $sig0;
-
- croak('sign_sig0() is only available when Net::DNS::SEC is installed')
- unless $Net::DNS::DNSSEC;
-
- if ( ref $arg ) {
- if ( UNIVERSAL::isa($arg,'Net::DNS::RR::SIG') ) {
- $sig0 = $arg;
-
- } elsif ( UNIVERSAL::isa($arg,'Net::DNS::SEC::Private') ) {
- $sig0 = Net::DNS::RR::SIG->create('', $arg);
-
- } elsif ( UNIVERSAL::isa($arg,'Net::DNS::RR::SIG::Private') ) {
- carp ref($arg).' is deprecated - use Net::DNS::SEC::Private instead';
- $sig0 = Net::DNS::RR::SIG->create('', $arg);
-
- } else {
- croak 'Incompatible class as argument to sign_sig0: '.ref($arg);
-
- }
-
- } else {
- $sig0 = Net::DNS::RR::SIG->create('', $arg);
- }
-
- $self->push('additional', $sig0) if $sig0;
- return $sig0;
-}
-
-
-
-=head1 COPYRIGHT
-
-Copyright (c) 1997-2002 Michael Fuhr.
-
-Portions Copyright (c) 2002-2004 Chris Reinhardt.
-
-Portions Copyright (c) 2002-2005 Olaf Kolkman
-
-Portions Copyright (c) 2007-2008 Dick Franks
-
-All rights reserved. This program is free software; you may redistribute
-it and/or modify it under the same terms as Perl itself.
-
-
-
-=head1 SEE ALSO
-
-L<perl(1)>, L<Net::DNS>, L<Net::DNS::Resolver>, L<Net::DNS::Update>,
-L<Net::DNS::Header>, L<Net::DNS::Question>, L<Net::DNS::RR>,
-RFC 1035 Section 4.1, RFC 2136 Section 2, RFC 2845
-
-=cut
-
-1;
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/Question.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/Question.pm
deleted file mode 100644
index a2094383e5e..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/Question.pm
+++ /dev/null
@@ -1,260 +0,0 @@
-package Net::DNS::Question;
-#
-# $Id: Question.pm 704 2008-02-06 21:30:59Z olaf $
-#
-use strict;
-BEGIN {
- eval { require bytes; }
-}
-
-use vars qw($VERSION $AUTOLOAD);
-
-use Carp;
-use Net::DNS;
-
-$VERSION = (qw$LastChangedRevision: 704 $)[1];
-
-=head1 NAME
-
-Net::DNS::Question - DNS question class
-
-=head1 SYNOPSIS
-
-C<use Net::DNS::Question>
-
-=head1 DESCRIPTION
-
-A C<Net::DNS::Question> object represents a record in the
-question section of a DNS packet.
-
-=head1 METHODS
-
-=head2 new
-
- $question = Net::DNS::Question->new("example.com", "MX", "IN");
-
-Creates a question object from the domain, type, and class passed
-as arguments.
-
-RFC4291 and RFC4632 IP address/prefix notation is supported for
-queries in in-addr.arpa and ip6.arpa subdomains.
-
-=cut
-
-sub new {
- my $class = shift;
-
- my $qname = shift;
- my $qtype = uc (shift || 'A');
- my $qclass = uc (shift || 'IN');
-
- $qname = '' unless defined $qname; # || ''; is NOT same!
- $qname =~ s/\.+$//o; # strip gratuitous trailing dot
-
- # Check if the caller has the type and class reversed.
- # We are not that kind for unknown types.... :-)
- ($qtype, $qclass) = ($qclass, $qtype)
- if exists $Net::DNS::classesbyname{$qtype}
- and exists $Net::DNS::typesbyname{$qclass};
-
- # if argument is an IP address, do appropriate reverse lookup
- my $reverse = _dns_addr($qname) if $qname =~ m/:|\d$/o;
- if ( $reverse ) {
- $qname = $reverse;
- $qtype = 'PTR' if $qtype =~ m/^(A|AAAA)$/o;
- }
-
- my $self = { qname => $qname,
- qtype => $qtype,
- qclass => $qclass
- };
-
- bless $self, $class;
-}
-
-
-sub _dns_addr {
- my $arg = shift; # name or IP address
-
- # IP address must contain address characters only
- return undef if $arg =~ m#[^a-fA-F0-9:./]#o;
-
- # if arg looks like IPv4 address then map to in-addr.arpa space
- if ( $arg =~ m#(^|:.*:)((^|\d+\.)+\d+)(/(\d+))?$#o ) {
- my @parse = split /\./, $2;
- my $prefx = $5 || @parse<<3;
- my $last = $prefx > 24 ? 3 : ($prefx-1)>>3;
- return join '.', reverse( (@parse,(0)x3)[0 .. $last] ), 'in-addr.arpa';
- }
-
- # if arg looks like IPv6 address then map to ip6.arpa space
- if ( $arg =~ m#^((\w*:)+)(\w*)(/(\d+))?$#o ) {
- my @parse = split /:/, (reverse "0${1}0${3}"), 9;
- my @xpand = map{/./ ? $_ : ('0')x(9-@parse)} @parse; # expand ::
- my $prefx = $5 || @xpand<<4; # implicit length if unspecified
- my $hex = pack 'A4'x8, map{$_.'000'} ('0')x(8-@xpand), @xpand;
- my $len = $prefx > 124 ? 32 : ($prefx+3)>>2;
- return join '.', split(//, substr($hex,-$len) ), 'ip6.arpa';
- }
-
- return undef;
-}
-
-
-=head2 parse
-
- ($question, $offset) = Net::DNS::Question->parse(\$data, $offset);
-
-Parses a question section record at the specified location within a DNS packet.
-The first argument is a reference to the packet data.
-The second argument is the offset within the packet where the question record begins.
-
-Returns a Net::DNS::Question object and the offset of the next location in the packet.
-
-Parsing is aborted if the question object cannot be created (e.g., corrupt or insufficient data).
-
-=cut
-
-use constant PACKED_LENGTH => length pack 'n2', (0)x2;
-
-sub parse {
- my ($class, $data, $offset) = @_;
-
- my ($qname, $index) = Net::DNS::Packet::dn_expand($data, $offset);
- die 'Exception: corrupt or incomplete data' unless $index;
-
- my $next = $index + PACKED_LENGTH;
- die 'Exception: incomplete data' if length $$data < $next;
- my ($qtype, $qclass) = unpack("\@$index n2", $$data);
-
- my $self = { qname => $qname,
- qtype => Net::DNS::typesbyval($qtype),
- qclass => Net::DNS::classesbyval($qclass)
- };
-
- bless $self, $class;
-
- return wantarray ? ($self, $next) : $self;
-}
-
-
-#
-# Some people have reported that Net::DNS dies because AUTOLOAD picks up
-# calls to DESTROY.
-#
-sub DESTROY {}
-
-=head2 qname, zname
-
- print "qname = ", $question->qname, "\n";
- print "zname = ", $question->zname, "\n";
-
-Returns the domain name. In dynamic update packets, this field is
-known as C<zname> and refers to the zone name.
-
-=head2 qtype, ztype
-
- print "qtype = ", $question->qtype, "\n";
- print "ztype = ", $question->ztype, "\n";
-
-Returns the record type. In dymamic update packets, this field is
-known as C<ztype> and refers to the zone type (must be SOA).
-
-=head2 qclass, zclass
-
- print "qclass = ", $question->qclass, "\n";
- print "zclass = ", $question->zclass, "\n";
-
-Returns the record class. In dynamic update packets, this field is
-known as C<zclass> and refers to the zone's class.
-
-=cut
-
-sub zname { &qname; }
-sub ztype { &qtype; }
-sub zclass { &qclass; }
-
-
-sub AUTOLOAD {
- my $self = shift;
-
- my $name = $AUTOLOAD;
- $name =~ s/.*://o;
-
- croak "$AUTOLOAD: no such method" unless exists $self->{$name};
-
- return $self->{$name} unless @_;
-
- my $value = shift;
- $value =~ s/\.+$//o if defined $value; # strip gratuitous trailing dot
- $self->{$name} = $value;
-}
-
-=head2 print
-
- $question->print;
-
-Prints the question record on the standard output.
-
-=cut
-
-sub print { print &string, "\n"; }
-
-=head2 string
-
- print $qr->string, "\n";
-
-Returns a string representation of the question record.
-
-=cut
-
-sub string {
- my $self = shift;
- return "$self->{qname}.\t$self->{qclass}\t$self->{qtype}";
-}
-
-=head2 data
-
- $qdata = $question->data($packet, $offset);
-
-Returns the question record in binary format suitable for inclusion
-in a DNS packet.
-
-Arguments are a C<Net::DNS::Packet> object and the offset within
-that packet's data where the C<Net::DNS::Question> record is to
-be stored. This information is necessary for using compressed
-domain names.
-
-=cut
-
-sub data {
- my ($self, $packet, $offset) = @_;
-
- my $data = $packet->dn_comp($self->{qname}, $offset);
-
- $data .= pack('n2', Net::DNS::typesbyname(uc $self->{qtype}),
- Net::DNS::classesbyname(uc $self->{qclass})
- );
- return $data;
-}
-
-=head1 COPYRIGHT
-
-Copyright (c) 1997-2002 Michael Fuhr.
-
-Portions Copyright (c) 2002-2004 Chris Reinhardt.
-
-Portions Copyright (c) 2003,2006-2007 Dick Franks.
-
-All rights reserved. This program is free software; you may redistribute
-it and/or modify it under the same terms as Perl itself.
-
-=head1 SEE ALSO
-
-L<perl(1)>, L<Net::DNS>, L<Net::DNS::Resolver>, L<Net::DNS::Packet>,
-L<Net::DNS::Update>, L<Net::DNS::Header>, L<Net::DNS::RR>,
-RFC 1035 Section 4.1.2
-
-=cut
-
-1;
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR.pm
deleted file mode 100644
index c3e2b829f8d..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR.pm
+++ /dev/null
@@ -1,1022 +0,0 @@
-package Net::DNS::RR;
-#
-# $Id: RR.pm 705 2008-02-06 21:59:18Z olaf $
-#
-use strict;
-
-BEGIN {
- eval { require bytes; }
-}
-
-
-use vars qw($VERSION $AUTOLOAD %rrsortfunct );
-use Carp;
-use Net::DNS;
-use Net::DNS::RR::Unknown;
-
-
-
-$VERSION = (qw$LastChangedRevision: 705 $)[1];
-
-=head1 NAME
-
-Net::DNS::RR - DNS Resource Record class
-
-=head1 SYNOPSIS
-
-C<use Net::DNS::RR>
-
-=head1 DESCRIPTION
-
-C<Net::DNS::RR> is the base class for DNS Resource Record (RR) objects.
-See also the manual pages for each RR type.
-
-=head1 METHODS
-
-B<WARNING!!!> Don't assume the RR objects you receive from a query
-are of a particular type -- always check an object's type before calling
-any of its methods. If you call an unknown method, you'll get a nasty
-warning message and C<Net::DNS::RR> will return C<undef> to the caller.
-
-=cut
-#' Stupid Emacs (I Don't even USE emacs!) '
-
-# %RR needs to be available within the scope of the BEGIN block.
-# $RR_REGEX is a global just to be on the safe side.
-# %_LOADED is used internally for autoloading the RR subclasses.
-use vars qw(%RR %_LOADED $RR_REGEX);
-
-BEGIN {
-
- %RR = map { $_ => 1 } qw(
- A
- AAAA
- AFSDB
- CNAME
- CERT
- DNAME
- EID
- HINFO
- ISDN
- LOC
- MB
- MG
- MINFO
- MR
- MX
- NAPTR
- NIMLOC
- NS
- NSAP
- NULL
- PTR
- PX
- RP
- RT
- SOA
- SRV
- TKEY
- TSIG
- TXT
- X25
- OPT
- SSHFP
- SPF
- IPSECKEY
- );
-
- # Only load DNSSEC if available
-
- eval {
- local $SIG{'__DIE__'} = 'DEFAULT';
- require Net::DNS::RR::SIG;
- };
-
- unless ($@) {
- $RR{'SIG'} = 1;
- eval {
- local $SIG{'__DIE__'} = 'DEFAULT';
- require Net::DNS::RR::NXT;
- };
-
- unless ($@) {
- $RR{'NXT'} = 1;
- } else {
- die $@;
- }
-
- eval {
- local $SIG{'__DIE__'} = 'DEFAULT';
- require Net::DNS::RR::KEY;
- };
-
- unless ($@) {
- $RR{'KEY'} = 1;
- } else {
- die $@;
- }
-
- eval {
- local $SIG{'__DIE__'} = 'DEFAULT';
- require Net::DNS::RR::DS;
- };
-
- unless ($@) {
- $RR{'DS'} = 1;
-
- } else {
- die $@;
- }
-
- eval {
- local $SIG{'__DIE__'} = 'DEFAULT';
- require Net::DNS::RR::RRSIG;
- };
-
- unless ($@) {
- $RR{'RRSIG'} = 1;
- # If RRSIG is available so should the other DNSSEC types
- eval {
- local $SIG{'__DIE__'} = 'DEFAULT';
- require Net::DNS::RR::NSEC;
- };
- unless ($@) {
- $RR{'NSEC'} = 1;
- } else {
- die $@;
- }
- eval {
- local $SIG{'__DIE__'} = 'DEFAULT';
- require Net::DNS::RR::DNSKEY;
- };
-
- unless ($@) {
- $RR{'DNSKEY'} = 1;
- } else {
- die $@;
- }
- }
-
- eval {
- local $SIG{'__DIE__'} = 'DEFAULT';
- require Net::DNS::RR::DLV;
- };
-
- unless ($@) {
- $RR{'DLV'} =1;
- } else {
- # Die only if we are dealing with a version for which DLV is
- # available
- die $@ if defined ($Net::DNS::SEC::HAS_DLV) ;
-
- }
-
- eval {
- local $SIG{'__DIE__'} = 'DEFAULT';
- require Net::DNS::RR::NSEC3;
- };
-
- unless ($@) {
- $RR{'NSEC3'} =1;
- } else {
- # Die only if we are dealing with a version for which NSEC3 is # available
- die $@ if defined ($Net::DNS::SEC::HAS_NSEC3);
- }
-
-
- eval {
- local $SIG{'__DIE__'} = 'DEFAULT';
- require Net::DNS::RR::NSEC3PARAM;
- };
-
- unless ($@) {
- $RR{'NSEC3PARAM'} =1;
- } else {
- # Die only if we are dealing with a version for which NSEC3 is
- # available
-
- die $@ if defined($Net::DNS::SEC::SVNVERSION) && $Net::DNS::SEC::SVNVERSION > 619; # In the code since. (for users of the SVN trunk)
- }
-
-
-
- }
-}
-
-sub build_regex {
- my $classes = join('|', keys %Net::DNS::classesbyname, 'CLASS\\d+');
-
- # Longest ones go first, so the regex engine will match AAAA before A.
- my $types = join('|', sort { length $b <=> length $a } keys %Net::DNS::typesbyname);
-
- $types .= '|TYPE\\d+';
-
- $RR_REGEX = " ^
- \\s*
- (\\S+) # name anything non-space will do
- \\s*
- (\\d+)?
- \\s*
- ($classes)?
- \\s*
- ($types)?
- \\s*
- (.*)
- \$";
-
-# print STDERR "Regex: $RR_REGEX\n";
-}
-
-
-=head2 new (from string)
-
- $a = Net::DNS::RR->new("foo.example.com. 86400 A 10.1.2.3");
- $mx = Net::DNS::RR->new("example.com. 7200 MX 10 mailhost.example.com.");
- $cname = Net::DNS::RR->new("www.example.com 300 IN CNAME www1.example.com");
- $txt = Net::DNS::RR->new('baz.example.com 3600 HS TXT "text record"');
-
-Returns a C<Net::DNS::RR> object of the appropriate type and
-initialized from the string passed by the user. The format of the
-string is that used in zone files, and is compatible with the string
-returned by C<< Net::DNS::RR->string >>.
-
-The name and RR type are required; all other information is optional.
-If omitted, the TTL defaults to 0 and the RR class defaults to IN.
-Omitting the optional fields is useful for creating the empty RDATA
-sections required for certain dynamic update operations. See the
-C<Net::DNS::Update> manual page for additional examples.
-
-All names must be fully qualified. The trailing dot (.) is optional.
-
-=head2 new (from hash)
-
- $rr = Net::DNS::RR->new(
- name => "foo.example.com",
- ttl => 86400,
- class => "IN",
- type => "A",
- address => "10.1.2.3",
- );
-
- $rr = Net::DNS::RR->new(
- name => "foo.example.com",
- type => "A",
- );
-
-Returns an RR object of the appropriate type, or a C<Net::DNS::RR>
-object if the type isn't implemented. See the manual pages for
-each RR type to see what fields the type requires.
-
-The C<Name> and C<Type> fields are required; all others are optional.
-If omitted, C<TTL> defaults to 0 and C<Class> defaults to IN. Omitting
-the optional fields is useful for creating the empty RDATA sections
-required for certain dynamic update operations.
-
-The fields are case-insensitive, but starting each with uppercase
-is recommended.
-
-=cut
-
-#' Stupid Emacs
-
-
-sub new {
- return new_from_string(@_) if @_ == 2;
- return new_from_string(@_) if @_ == 3;
-
- return new_from_hash(@_);
-}
-
-
-sub new_from_data {
- my $class = shift;
- my ($name, $rrtype, $rrclass, $ttl, $rdlength, $data, $offset) = @_;
-
- my $self = { name => $name,
- type => $rrtype,
- class => $rrclass,
- ttl => $ttl,
- rdlength => $rdlength,
- rdata => substr($$data, $offset, $rdlength)
- };
-
- if ($RR{$rrtype}) {
- my $subclass = $class->_get_subclass($rrtype);
- return $subclass->new($self, $data, $offset);
- } else {
- return Net::DNS::RR::Unknown->new($self, $data, $offset);
- }
-
-}
-
-sub new_from_string {
- my ($class, $rrstring, $update_type) = @_;
-
- build_regex() unless $RR_REGEX;
-
- # strip out comments
- # Test for non escaped ";" by means of the look-behind assertion
- # (the backslash is escaped)
- $rrstring =~ s/(?<!\\);.*//og;
-
- ($rrstring =~ m/$RR_REGEX/xso) ||
- confess qq|qInternal Error: "$rrstring" did not match RR pat.\nPlease report this to the author!\n|;
-
- my $name = $1;
- my $ttl = $2 || 0;
- my $rrclass = $3 || '';
-
-
- my $rrtype = $4 || '';
- my $rdata = $5 || '';
-
- $rdata =~ s/\s+$//o if $rdata;
- $name =~ s/\.$//o if $name;
-
-
-
- # RFC3597 tweaks
- # This converts to known class and type if specified as TYPE###
- $rrtype = Net::DNS::typesbyval(Net::DNS::typesbyname($rrtype)) if $rrtype =~ m/^TYPE\d+/o;
- $rrclass = Net::DNS::classesbyval(Net::DNS::classesbyname($rrclass)) if $rrclass =~ m/^CLASS\d+/o;
-
-
- if (!$rrtype && $rrclass && $rrclass eq 'ANY') {
- $rrtype = 'ANY';
- $rrclass = 'IN';
- } elsif (!$rrclass) {
- $rrclass = 'IN';
- }
-
- $rrtype ||= 'ANY';
-
-
- if ($update_type) {
- $update_type = lc $update_type;
-
- if ($update_type eq 'yxrrset') {
- $ttl = 0;
- $rrclass = 'ANY' unless $rdata;
- } elsif ($update_type eq 'nxrrset') {
- $ttl = 0;
- $rrclass = 'NONE';
- $rdata = '';
- } elsif ($update_type eq 'yxdomain') {
- $ttl = 0;
- $rrclass = 'ANY';
- $rrtype = 'ANY';
- $rdata = '';
- } elsif ($update_type eq 'nxdomain') {
- $ttl = 0;
- $rrclass = 'NONE';
- $rrtype = 'ANY';
- $rdata = '';
- } elsif ($update_type =~ /^(rr_)?add$/o) {
- $ttl = 86400 unless $ttl;
- } elsif ($update_type =~ /^(rr_)?del(ete)?$/o) {
- $ttl = 0;
- $rrclass = $rdata ? 'NONE' : 'ANY';
- }
- }
-
- # We used to check if $rrtype was defined at this point. However,
- # we just defaulted it to ANY earlier....
-
- my $self = {
- 'name' => $name,
- 'type' => $rrtype,
- 'class' => $rrclass,
- 'ttl' => $ttl,
- 'rdlength' => 0,
- 'rdata' => '',
- };
-
- if ($RR{$rrtype} && $rdata !~ m/^\s*\\#/o ) {
- my $subclass = $class->_get_subclass($rrtype);
- return $subclass->new_from_string($self, $rdata);
- } elsif ($RR{$rrtype}) { # A RR type known to Net::DNS starting with \#
- $rdata =~ m/\\\#\s+(\d+)\s+(.*)$/o;
-
- my $rdlength = $1;
- my $hexdump = $2;
- $hexdump =~ s/\s*//og;
-
- die "$rdata is inconsistent; length does not match content"
- if length($hexdump) != $rdlength*2;
-
- $rdata = pack('H*', $hexdump);
-
- return Net::DNS::RR->new_from_data(
- $name,
- $rrtype,
- $rrclass,
- $ttl,
- $rdlength,
- \$rdata,
- length($rdata) - $rdlength
- );
- } elsif ($rdata=~/\s*\\\#\s+\d+\s+/o) {
- #We are now dealing with the truly unknown.
- die 'Expected RFC3597 representation of RDATA'
- unless $rdata =~ m/\\\#\s+(\d+)\s+(.*)$/o;
-
- my $rdlength = $1;
- my $hexdump = $2;
- $hexdump =~ s/\s*//og;
-
- die "$rdata is inconsistent; length does not match content"
- if length($hexdump) != $rdlength*2;
-
- $rdata = pack('H*', $hexdump);
-
- return Net::DNS::RR->new_from_data(
- $name,
- $rrtype,
- $rrclass,
- $ttl,
- $rdlength,
- \$rdata,
- length($rdata) - $rdlength
- );
- } else {
- #God knows how to handle these... bless them in the RR class.
- bless $self, $class;
- return $self
- }
-
-}
-
-sub new_from_hash {
- my $class = shift;
- my %keyval = @_;
- my $self = {};
-
- while ( my ($key, $val) = each %keyval ) {
- ( $self->{lc $key} = $val ) =~ s/\.+$// if defined $val;
- }
-
- croak('RR name not specified') unless defined $self->{name};
- croak('RR type not specified') unless defined $self->{type};
-
- $self->{'ttl'} ||= 0;
- $self->{'class'} ||= 'IN';
-
- $self->{'rdlength'} = length $self->{'rdata'}
- if $self->{'rdata'};
-
- if ($RR{$self->{'type'}}) {
- my $subclass = $class->_get_subclass($self->{'type'});
-
- if (uc $self->{'type'} ne 'OPT') {
- bless $self, $subclass;
-
- return $self;
- } else {
- # Special processing of OPT. Since TTL and CLASS are
- # set by other variables. See Net::DNS::RR::OPT
- # documentation
- return $subclass->new_from_hash($self);
- }
- } elsif ($self->{'type'} =~ /TYPE\d+/o) {
- bless $self, 'Net::DNS::RR::Unknown';
- return $self;
- } else {
- bless $self, $class;
- return $self;
- }
-}
-
-
-=head2 parse
-
- ($rrobj, $offset) = Net::DNS::RR->parse(\$data, $offset);
-
-Parses a DNS resource record at the specified location within a DNS packet.
-The first argument is a reference to the packet data.
-The second argument is the offset within the packet where the resource record begins.
-
-Returns a Net::DNS::RR object and the offset of the next location in the packet.
-
-Parsing is aborted if the object could not be created (e.g., corrupt or insufficient data).
-
-=cut
-
-use constant PACKED_LENGTH => length pack 'n2 N n', (0)x4;
-
-sub parse {
- my ($objclass, $data, $offset) = @_;
-
- my ($name, $index) = Net::DNS::Packet::dn_expand($data, $offset);
- die 'Exception: corrupt or incomplete data' unless $index;
-
- my $rdindex = $index + PACKED_LENGTH;
- die 'Exception: incomplete data' if length $$data < $rdindex;
- my ($type, $class, $ttl, $rdlength) = unpack("\@$index n2 N n", $$data);
-
- my $next = $rdindex + $rdlength;
- die 'Exception: incomplete data' if length $$data < $next;
-
- $type = Net::DNS::typesbyval($type) || $type;
-
- # Special case for OPT RR where CLASS should be
- # interpreted as 16 bit unsigned (RFC2671, 4.3)
- if ($type ne 'OPT') {
- $class = Net::DNS::classesbyval($class) || $class;
- }
- # else just retain numerical value
-
- my $self = $objclass->new_from_data($name, $type, $class, $ttl, $rdlength, $data, $rdindex);
- die 'Exception: corrupt or incomplete RR subtype data' unless defined $self;
-
- return wantarray ? ($self, $next) : $self;
-}
-
-
-#
-# Some people have reported that Net::DNS dies because AUTOLOAD picks up
-# calls to DESTROY.
-#
-sub DESTROY {}
-
-=head2 print
-
- $rr->print;
-
-Prints the record to the standard output. Calls the
-B<string> method to get the RR's string representation.
-
-=cut
-#' someone said that emacs gets screwy here. Who am I to claim otherwise...
-
-sub print { print &string, "\n"; }
-
-=head2 string
-
- print $rr->string, "\n";
-
-Returns a string representation of the RR. Calls the
-B<rdatastr> method to get the RR-specific data.
-
-=cut
-
-sub string {
- my $self = shift;
- my $data = $self->rdatastr || '; no data';
-
- join "\t", "$self->{name}.", $self->{ttl}, $self->{class}, $self->{type}, $data;
-}
-
-=head2 rdatastr
-
- $s = $rr->rdatastr;
-
-Returns a string containing RR-specific data. Subclasses will need
-to implement this method.
-
-=cut
-
-sub rdatastr {
- my $self = shift;
- return exists $self->{'rdlength'}
- ? "; rdlength = $self->{'rdlength'}"
- : '';
-}
-
-=head2 name
-
- $name = $rr->name;
-
-Returns the record's domain name.
-
-=head2 type
-
- $type = $rr->type;
-
-Returns the record's type.
-
-=head2 class
-
- $class = $rr->class;
-
-Returns the record's class.
-
-=cut
-
-# Used to AUTOLOAD this, but apparently some versions of Perl (specifically
-# 5.003_07, included with some Linux distributions) would return the
-# class the object was blessed into, instead of the RR's class.
-
-sub class {
- my $self = shift;
-
- if (@_) {
- $self->{'class'} = shift;
- } elsif (!exists $self->{'class'}) {
- Carp::carp('class: no such method');
- return undef;
- }
- return $self->{'class'};
-}
-
-
-=head2 ttl
-
- $ttl = $rr->ttl;
-
-Returns the record's time-to-live (TTL).
-
-=head2 rdlength
-
- $rdlength = $rr->rdlength;
-
-Returns the length of the record's data section.
-
-=head2 rdata
-
- $rdata = $rr->rdata
-
-Returns the record's data section as binary data.
-
-=cut
-#'
-sub rdata {
- my $self = shift;
- my $retval = undef;
-
- if (@_ == 2) {
- my ($packet, $offset) = @_;
- $retval = $self->rr_rdata($packet, $offset);
- }
- elsif (exists $self->{'rdata'}) {
- $retval = $self->{'rdata'};
- }
-
- return $retval;
-}
-
-sub rr_rdata {
- my $self = shift;
- return exists $self->{'rdata'} ? $self->{'rdata'} : '';
-}
-
-#------------------------------------------------------------------------------
-# sub data
-#
-# This method is called by Net::DNS::Packet->data to get the binary
-# representation of an RR.
-#------------------------------------------------------------------------------
-
-sub data {
- my ($self, $packet, $offset) = @_;
- my $data;
-
-
- # Don't compress TSIG or TKEY names and don't mess with EDNS0 packets
- if (uc($self->{'type'}) eq 'TSIG' || uc($self->{'type'}) eq 'TKEY') {
- my $tmp_packet = Net::DNS::Packet->new();
- $data = $tmp_packet->dn_comp($self->{'name'}, 0);
- return undef unless defined $data;
- } elsif (uc($self->{'type'}) eq 'OPT') {
- my $tmp_packet = Net::DNS::Packet->new();
- $data = $tmp_packet->dn_comp('', 0);
- } else {
- $data = $packet->dn_comp($self->{'name'}, $offset);
- return undef unless defined $data;
- }
-
- my $qtype = uc($self->{'type'});
- my $qtype_val = ($qtype =~ m/^\d+$/o) ? $qtype : Net::DNS::typesbyname($qtype);
- $qtype_val = 0 if !defined($qtype_val);
-
- my $qclass = uc($self->{'class'});
- my $qclass_val = ($qclass =~ m/^\d+$/o) ? $qclass : Net::DNS::classesbyname($qclass);
- $qclass_val = 0 if !defined($qclass_val);
- $data .= pack('n', $qtype_val);
-
- # If the type is OPT then class will need to contain a decimal number
- # containing the UDP payload size. (RFC2671 section 4.3)
- if (uc($self->{'type'}) ne 'OPT') {
- $data .= pack('n', $qclass_val);
- } else {
- $data .= pack('n', $self->{'class'});
- }
-
- $data .= pack('N', $self->{'ttl'});
-
- $offset += length($data) + &Net::DNS::INT16SZ; # allow for rdlength
-
- my $rdata = $self->rdata($packet, $offset);
-
- $data .= pack('n', length $rdata);
- $data.=$rdata;
-
- return $data;
-}
-
-
-
-
-
-#------------------------------------------------------------------------------
-# This method is called by SIG objects verify method.
-# It is almost the same as data but needed to get an representation of the
-# packets in wire format withoud domain name compression.
-# It is essential to DNSSEC RFC 2535 section 8
-#------------------------------------------------------------------------------
-
-sub _canonicaldata {
- my $self = shift;
- my $data='';
- {
- my $name=$self->{'name'};
- my @dname=Net::DNS::name2labels($name);
- for (my $i=0;$i<@dname;$i++){
- $data .= pack ('C',length $dname[$i] );
- $data .= lc($dname[$i] );
- }
- $data .= pack ('C','0');
- }
- $data .= pack('n', Net::DNS::typesbyname(uc($self->{'type'})));
- $data .= pack('n', Net::DNS::classesbyname(uc($self->{'class'})));
- $data .= pack('N', $self->{'ttl'});
-
-
- my $rdata = $self->_canonicalRdata;
-
- $data .= pack('n', length $rdata);
- $data .= $rdata;
- return $data;
-
-
-}
-
-# These are methods that are used in the DNSSEC context... Some RR
-# have domain names in them. Verification works only on RRs with
-# uncompressed domain names. (Canonical format as in sect 8 of
-# RFC2535) _canonicalRdata is overwritten in those RR objects that
-# have domain names in the RDATA and _name2wire is used to convert a
-# domain name to "wire format"
-
-
-sub _canonicalRdata {
- my $self=shift;
- my $packet=Net::DNS::Packet->new();
- my $rdata = $self->rr_rdata($packet,0);
- return $rdata;
-}
-
-
-
-
-
-sub _name2wire {
- my ($self, $name) = @_;
-
- my $rdata="";
- my $compname = "";
- my @dname = Net::DNS::name2labels($name);
-
-
- for (@dname) {
- $rdata .= pack('C', length $_);
- $rdata .= $_ ;
- }
-
- $rdata .= pack('C', '0');
- return $rdata;
-}
-
-
-
-
-
-sub AUTOLOAD {
- my ($self) = @_; # If we do shift here, it will mess up the goto below.
- my ($name) = $AUTOLOAD =~ m/^.*::(.*)$/o;
- if ($name =~ /set_rrsort_func/){
- return Net::DNS::RR::set_rrsort_func(@_);
- }
- if ($name =~ /get_rrsort_func/){
- return Net::DNS::RR::get_rrsort_func(@_);
- }
- # XXX -- We should test that we do in fact carp on unknown methods.
- unless (exists $self->{$name}) {
- my $rr_string = $self->string;
- Carp::carp(<<"AMEN");
-
-***
-*** WARNING!!! The program has attempted to call the method
-*** "$name" for the following RR object:
-***
-*** $rr_string
-***
-*** This object does not have a method "$name". THIS IS A BUG
-*** IN THE CALLING SOFTWARE, which has incorrectly assumed that
-*** the object would be of a particular type. The calling
-*** software should check the type of each RR object before
-*** calling any of its methods.
-***
-*** Net::DNS has returned undef to the caller.
-***
-
-AMEN
-return;
- }
-
- no strict q/refs/;
-
- # Build a method in the class.
- *{$AUTOLOAD} = sub {
- my ($self, $new_val) = @_;
-
- if (defined $new_val) {
- $self->{$name} = $new_val;
- }
-
- return $self->{$name};
- };
-
- # And jump over to it.
- goto &{$AUTOLOAD};
-}
-
-
-
-#
-# Net::DNS::RR->_get_subclass($type)
-#
-# Return a subclass, after loading a subclass (if needed)
-#
-sub _get_subclass {
- my ($class, $type) = @_;
-
- return unless $type and $RR{$type};
-
- my $subclass = join('::', $class, $type);
-
- unless ($_LOADED{$subclass}) {
- eval "require $subclass";
- die $@ if $@;
- $_LOADED{$subclass}++;
- }
-
- return $subclass;
-}
-
-
-
-
-=head1 Sorting of RR arrays
-
-As of version 0.55 there is functionality to help you sort RR
-arrays. The sorting is done by Net::DNS::rrsort(), see the
-L<Net::DNS> documentation. This package provides class methods to set
-the sorting functions used for a particular RR based on a particular
-attribute.
-
-
-=head2 set_rrsort_func
-
-Net::DNS::RR::SRV->set_rrsort_func("priority",
- sub {
- my ($a,$b)=($Net::DNS::a,$Net::DNS::b);
- $a->priority <=> $b->priority
- ||
- $b->weight <=> $a->weight
- }
-
-Net::DNS::RR::SRV->set_rrsort_func("default_sort",
- sub {
- my ($a,$b)=($Net::DNS::a,$Net::DNS::b);
- $a->priority <=> $b->priority
- ||
- $b->weight <=> $a->weight
- }
-
-set_rrsort_func needs to be called as a class method. The first
-argument is the attribute name on which the sorting will need to take
-place. If you specify "default_sort" than that is the sort algorithm
-that will be used in the case that rrsort() is called without an RR
-attribute as argument.
-
-The second argument is a reference to a function that uses the
-variables $a and $b global to the C<from Net::DNS>(!!)package for the
-sorting. During the sorting $a and $b will contain references to
-objects from the class you called the set_prop_sort from. In other
-words, you can rest assured that the above sorting function will only
-get Net::DNS::RR::SRV objects.
-
-The above example is the sorting function that actually is implemented in
-SRV.
-
-=cut
-
-
-
-
-sub set_rrsort_func{
- my $class=shift;
- my $attribute=shift;
- my $funct=shift;
-# print "Using ".__PACKAGE__."set_rrsort: $class\n";
- my ($type) = $class =~ m/^.*::(.*)$/o;
- $Net::DNS::RR::rrsortfunct{$type}{$attribute}=$funct;
-}
-
-sub get_rrsort_func {
- my $class=shift;
- my $attribute=shift; #can be undefined.
- my $sortsub;
- my ($type) = $class =~ m/^.*::(.*)$/o;
-
-
-# print "Using ".__PACKAGE__." get_rrsort: $class ($type,$attribute)\n";
-# use Data::Dumper;
-# print Dumper %Net::DNS::rrsortfunct;
-
- if (defined($attribute) &&
- exists($Net::DNS::RR::rrsortfunct{$type}) &&
- exists($Net::DNS::RR::rrsortfunct{$type}{$attribute})
- ){
- # The default overwritten by the class variable in Net::DNS
- return $Net::DNS::RR::rrsortfunct{$type}{$attribute};
- }elsif(
- ! defined($attribute) &&
- exists($Net::DNS::RR::rrsortfunct{$type}) &&
- exists($Net::DNS::RR::rrsortfunct{$type}{'default_sort'})
- ){
- # The default overwritten by the class variable in Net::DNS
- return $Net::DNS::RR::rrsortfunct{$type}{'default_sort'};
- }
- elsif( defined($attribute) ){
-
- return sub{
- my ($a,$b)=($Net::DNS::a,$Net::DNS::b);
- ( exists($a->{$attribute}) &&
- $a->{$attribute} <=> $b->{$attribute})
- ||
- $a->_canonicaldata() cmp $b->_canonicaldata()
- };
- }else{
- return sub{
- my ($a,$b)=($Net::DNS::a,$Net::DNS::b);
- $a->_canonicaldata() cmp $b->_canonicaldata()
- };
- }
-
- return $sortsub;
-}
-
-
-
-
-
-
-
-sub STORABLE_freeze {
- my ($self, $cloning) = @_;
-
- return if $cloning;
-
- return ('', {%$self});
-}
-
-sub STORABLE_thaw {
- my ($self, $cloning, undef, $data) = @_;
-
- %{$self} = %{$data};
-
- __PACKAGE__->_get_subclass($self->{'type'});
-
- return $self;
-}
-
-=head1 BUGS
-
-This version of C<Net::DNS::RR> does little sanity checking on user-created
-RR objects.
-
-=head1 COPYRIGHT
-
-Copyright (c) 1997-2002 Michael Fuhr.
-
-Portions Copyright (c) 2002-2004 Chris Reinhardt.
-
-Portions Copyright (c) 2005-2007 Olaf Kolkman
-
-Portions Copyright (c) 2007 Dick Franks
-
-All rights reserved. This program is free software; you may redistribute
-it and/or modify it under the same terms as Perl itself.
-
-EDNS0 extensions by Olaf Kolkman.
-
-=head1 SEE ALSO
-
-L<perl(1)>, L<Net::DNS>, L<Net::DNS::Resolver>, L<Net::DNS::Packet>,
-L<Net::DNS::Update>, L<Net::DNS::Header>, L<Net::DNS::Question>,
-RFC 1035 Section 4.1.3
-
-=cut
-
-1;
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/A.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/A.pm
deleted file mode 100644
index 0ff7be36f75..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/A.pm
+++ /dev/null
@@ -1,95 +0,0 @@
-package Net::DNS::RR::A;
-#
-# $Id: A.pm 546 2005-12-16 15:23:03Z olaf $
-#
-use strict;
-BEGIN {
- eval { require bytes; }
-}
-
-
-use vars qw(@ISA $VERSION);
-
-use Socket;
-
-@ISA = qw(Net::DNS::RR);
-$VERSION = (qw$LastChangedRevision: 546 $)[1];
-
-sub new {
- my ($class, $self, $data, $offset) = @_;
-
- if ($self->{"rdlength"} > 0) {
- $self->{"address"} = inet_ntoa(substr($$data, $offset, 4));
- }
-
- return bless $self, $class;
-}
-
-sub new_from_string {
- my ($class, $self, $string) = @_;
-
- if ($string && ($string =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)\s*$/o)
- && ($1 >= 0) && ($1 <= 255)
- && ($2 >= 0) && ($2 <= 255)
- && ($3 >= 0) && ($3 <= 255)
- && ($4 >= 0) && ($4 <= 255) ) {
-
- $self->{"address"} = "$1.$2.$3.$4";
- }
-
- return bless $self, $class;
-}
-
-sub rdatastr {
- my $self = shift;
-
- return $self->{"address"} || '';
-}
-
-sub rr_rdata {
- my $self = shift;
-
- return exists $self->{"address"}
- ? inet_aton($self->{"address"})
- : "";
-}
-
-1;
-__END__
-
-=head1 NAME
-
-Net::DNS::RR::A - DNS A resource record
-
-=head1 SYNOPSIS
-
-C<use Net::DNS::RR>;
-
-=head1 DESCRIPTION
-
-Class for DNS Address (A) resource records.
-
-=head1 METHODS
-
-=head2 address
-
- print "address = ", $rr->address, "\n";
-
-Returns the RR's address field.
-
-=head1 COPYRIGHT
-
-Copyright (c) 1997-2002 Michael Fuhr.
-
-Portions Copyright (c) 2002-2004 Chris Reinhardt.
-
-All rights reserved. This program is free software; you may redistribute
-it and/or modify it under the same terms as Perl itself.
-
-=head1 SEE ALSO
-
-L<perl(1)>, L<Net::DNS>, L<Net::DNS::Resolver>, L<Net::DNS::Packet>,
-L<Net::DNS::Header>, L<Net::DNS::Question>, L<Net::DNS::RR>,
-RFC 1035 Section 3.4.1
-
-=cut
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/AAAA.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/AAAA.pm
deleted file mode 100644
index f8c6a212465..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/AAAA.pm
+++ /dev/null
@@ -1,124 +0,0 @@
-package Net::DNS::RR::AAAA;
-#
-# $Id: AAAA.pm 388 2005-06-22 10:06:05Z olaf $
-#
-use strict;
-BEGIN {
- eval { require bytes; }
-}
-
-use vars qw(@ISA $VERSION);
-
-@ISA = qw(Net::DNS::RR);
-$VERSION = (qw$LastChangedRevision: 388 $)[1];
-
-sub new {
- my ($class, $self, $data, $offset) = @_;
-
- if ($self->{"rdlength"} > 0) {
- my @addr = unpack("\@$offset n8", $$data);
- $self->{"address"} = sprintf("%x:%x:%x:%x:%x:%x:%x:%x", @addr);
- }
- return bless $self, $class;
-}
-
-sub new_from_string {
- my ($class, $self, $string) = @_;
-
- if ($string) {
- my @addr;
-
- # I think this is correct, per RFC 1884 Sections 2.2 & 2.4.4.
- if ($string =~ /^(.*):(\d+)\.(\d+)\.(\d+)\.(\d+)$/) {
- my ($front, $a, $b, $c, $d) = ($1, $2, $3, $4, $5);
- $string = $front . sprintf(":%x:%x",
- ($a << 8 | $b),
- ($c << 8 | $d));
- }
-
- if ($string =~ /^(.*)::(.*)$/) {
- my ($front, $back) = ($1, $2);
- my @front = split(/:/, $front);
- my @back = split(/:/, $back);
- my $fill = 8 - (@front ? $#front + 1 : 0)
- - (@back ? $#back + 1 : 0);
- my @middle = (0) x $fill;
- @addr = (@front, @middle, @back);
- }
- else {
- @addr = split(/:/, $string);
- if (@addr < 8) {
- @addr = ((0) x (8 - @addr), @addr);
- }
- }
-
- $self->{"address"} = sprintf("%x:%x:%x:%x:%x:%x:%x:%x",
- map { hex $_ } @addr);
- }
-
- return bless $self, $class;
-}
-
-sub rdatastr {
- my $self = shift;
-
- return $self->{"address"} || '';
-}
-
-sub rr_rdata {
- my $self = shift;
- my $rdata = "";
-
- if (exists $self->{"address"}) {
- my @addr = split(/:/, $self->{"address"});
- $rdata .= pack("n8", map { hex $_ } @addr);
- }
-
- return $rdata;
-}
-
-1;
-__END__
-
-=head1 NAME
-
-Net::DNS::RR::AAAA - DNS AAAA resource record
-
-=head1 SYNOPSIS
-
-C<use Net::DNS::RR>;
-
-=head1 DESCRIPTION
-
-Class for DNS IPv6 Address (AAAA) resource records.
-
-=head1 METHODS
-
-=head2 address
-
- print "address = ", $rr->address, "\n";
-
-Returns the RR's address field.
-
-=head1 BUGS
-
-The C<string> method returns only the preferred method of address
-representation ("x:x:x:x:x:x:x:x", as documented in RFC 1884,
-Section 2.2, Para 1).
-
-=head1 COPYRIGHT
-
-Copyright (c) 1997-2002 Michael Fuhr.
-
-Portions Copyright (c) 2002-2004 Chris Reinhardt.
-
-All rights reserved. This program is free software; you may redistribute
-it and/or modify it under the same terms as Perl itself.
-
-=head1 SEE ALSO
-
-L<perl(1)>, L<Net::DNS>, L<Net::DNS::Resolver>, L<Net::DNS::Packet>,
-L<Net::DNS::Header>, L<Net::DNS::Question>, L<Net::DNS::RR>,
-RFC 1886 Section 2, RFC 1884 Sections 2.2 & 2.4.4
-
-=cut
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/AFSDB.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/AFSDB.pm
deleted file mode 100644
index 8b941adbfff..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/AFSDB.pm
+++ /dev/null
@@ -1,122 +0,0 @@
-package Net::DNS::RR::AFSDB;
-#
-# $Id: AFSDB.pm 632 2007-03-12 13:24:21Z olaf $
-#
-use strict;
-
-BEGIN {
- eval { require bytes; }
-}
-
-use vars qw(@ISA $VERSION);
-
-@ISA = qw(Net::DNS::RR);
-$VERSION = (qw$LastChangedRevision: 632 $)[1];
-
-sub new {
- my ($class, $self, $data, $offset) = @_;
-
- if ($self->{"rdlength"} > 0) {
- my ($subtype) = unpack("\@$offset n", $$data);
- $offset += Net::DNS::INT16SZ();
- my($hostname) = Net::DNS::Packet::dn_expand($data, $offset);
- $self->{"subtype"} = $subtype;
- $self->{"hostname"} = $hostname;
- }
-
- return bless $self, $class;
-}
-
-sub new_from_string {
- my ($class, $self, $string) = @_;
-
- if ($string && ($string =~ /^(\d+)\s+(\S+)$/)) {
- $self->{"subtype"} = $1;
- $self->{"hostname"} = $2;
- $self->{"hostname"} =~ s/\.+$//;;
- }
-
- return bless $self, $class;
-}
-
-sub rdatastr {
- my $self = shift;
-
- return exists $self->{"subtype"}
- ? "$self->{subtype} $self->{hostname}."
- : '';
-}
-
-sub rr_rdata {
- my ($self, $packet, $offset) = @_;
- my $rdata = "";
-
- if (exists $self->{"subtype"}) {
- $rdata .= pack("n", $self->{"subtype"});
- $rdata .= $packet->dn_comp($self->{"hostname"},
- $offset + length $rdata);
- }
-
- return $rdata;
-}
-
-
-
-sub _canonicalRdata {
- # rdata contains a compressed domainname... we should not have that.
- my ($self) = @_;
- my $rdata;
- if (exists $self->{"subtype"}) {
- $rdata .= pack("n", $self->{"subtype"});
- $rdata .= $self->_name2wire(lc($self->{"hostname"}));
- }
- return $rdata;
-}
-
-
-1;
-__END__
-
-=head1 NAME
-
-Net::DNS::RR::AFSDB - DNS AFSDB resource record
-
-=head1 SYNOPSIS
-
-C<use Net::DNS::RR>;
-
-=head1 DESCRIPTION
-
-Class for DNS AFS Data Base (AFSDB) resource records.
-
-=head1 METHODS
-
-=head2 subtype
-
- print "subtype = ", $rr->subtype, "\n";
-
-Returns the RR's subtype field. Use of the subtype field is documented
-in RFC 1183.
-
-=head2 hostname
-
- print "hostname = ", $rr->hostname, "\n";
-
-Returns the RR's hostname field. See RFC 1183.
-
-=head1 COPYRIGHT
-
-Copyright (c) 1997-2002 Michael Fuhr.
-
-Portions Copyright (c) 2002-2004 Chris Reinhardt.
-
-All rights reserved. This program is free software; you may redistribute
-it and/or modify it under the same terms as Perl itself.
-
-=head1 SEE ALSO
-
-L<perl(1)>, L<Net::DNS>, L<Net::DNS::Resolver>, L<Net::DNS::Packet>,
-L<Net::DNS::Header>, L<Net::DNS::Question>, L<Net::DNS::RR>,
-RFC 1183 Section 1
-
-=cut
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/CERT.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/CERT.pm
deleted file mode 100644
index 011d7871474..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/CERT.pm
+++ /dev/null
@@ -1,178 +0,0 @@
-package Net::DNS::RR::CERT;
-#
-# $Id: CERT.pm 388 2005-06-22 10:06:05Z olaf $
-#
-# Written by Mike Schiraldi <raldi@research.netsol.com> for VeriSign
-
-use strict;
-BEGIN {
- eval { require bytes; }
-}
-use vars qw(@ISA $VERSION);
-
-use MIME::Base64;
-
-@ISA = qw(Net::DNS::RR);
-$VERSION = (qw$LastChangedRevision: 388 $)[1];
-
-my %formats = (
- PKIX => 1,
- SPKI => 2,
- PGP => 3,
- URI => 253,
- OID => 254,
-);
-
-my %r_formats = reverse %formats;
-
-my %algorithms = (
- RSAMD5 => 1,
- DH => 2,
- DSA => 3,
- ECC => 4,
- INDIRECT => 252,
- PRIVATEDNS => 253,
- PRIVATEOID => 254,
-);
-
-my %r_algorithms = reverse %algorithms;
-
-sub new {
- my ($class, $self, $data, $offset) = @_;
-
- if ($self->{"rdlength"} > 0) {
- my ($format, $tag, $algorithm) = unpack("\@$offset n2C", $$data);
-
- $offset += 2 * Net::DNS::INT16SZ() + 1;
-
- my $length = $self->{"rdlength"} - (2 * Net::DNS::INT16SZ() + 1);
- my $certificate = substr($$data, $offset, $length);
-
- $self->{"format"} = $format;
- $self->{"tag"} = $tag;
- $self->{"algorithm"} = $algorithm;
- $self->{"certificate"} = $certificate;
- }
-
- return bless $self, $class;
-}
-
-sub new_from_string {
- my ($class, $self, $string) = @_;
-
- $string or return bless $self, $class;
-
- my ($format, $tag, $algorithm, @rest) = split " ", $string;
- @rest or return bless $self, $class;
-
- # look up mnemonics
- # the "die"s may be rash, but proceeding would be dangerous
- if ($algorithm =~ /\D/) {
- $algorithm = $algorithms{$algorithm} || die "Unknown algorithm mnemonic: '$algorithm'";
- }
-
- if ($format =~ /\D/) {
- $format = $formats{$format} || die "Unknown format mnemonic: '$format'";
- }
-
- $self->{"format"} = $format;
- $self->{"tag"} = $tag;
- $self->{"algorithm"} = $algorithm;
- $self->{"certificate"} = MIME::Base64::decode(join('', @rest));
-
-
- return bless $self, $class;
-}
-
-sub rdatastr {
- my $self = shift;
- my $rdatastr;
-
- if (exists $self->{"format"}) {
- my $cert = MIME::Base64::encode $self->{certificate};
- $cert =~ s/\n//g;
-
- my $format = defined $r_formats{$self->{"format"}}
- ? $r_formats{$self->{"format"}} : $self->{"format"};
-
- my $algorithm = defined $r_algorithms{$self->{algorithm}}
- ? $r_algorithms{$self->{algorithm}} : $self->{algorithm};
-
- $rdatastr = "$format $self->{tag} $algorithm $cert";
- } else {
- $rdatastr = '';
- }
-
- return $rdatastr;
-}
-
-sub rr_rdata {
- my ($self, $packet, $offset) = @_;
-
- my $rdata = "";
-
- if (exists $self->{"format"}) {
- $rdata .= pack("n2", $self->{"format"}, $self->{tag});
- $rdata .= pack("C", $self->{algorithm});
- $rdata .= $self->{certificate};
- }
-
- return $rdata;
-}
-
-1;
-__END__
-
-=head1 NAME
-
-Net::DNS::RR::CERT - DNS CERT resource record
-
-=head1 SYNOPSIS
-
-C<use Net::DNS::RR>;
-
-=head1 DESCRIPTION
-
-Class for DNS Certificate (CERT) resource records. (see RFC 2538)
-
-=head1 METHODS
-
-=head2 format
-
- print "format = ", $rr->format, "\n";
-
-Returns the format code for the certificate (in numeric form)
-
-=head2 tag
-
- print "tag = ", $rr->tag, "\n";
-
-Returns the key tag for the public key in the certificate
-
-=head2 algorithm
-
- print "algorithm = ", $rr->algorithm, "\n";
-
-Returns the algorithm used by the certificate (in numeric form)
-
-=head2 certificate
-
- print "certificate = ", $rr->certificate, "\n";
-
-Returns the data comprising the certificate itself (in raw binary form)
-
-=head1 COPYRIGHT
-
-Copyright (c) 1997-2002 Michael Fuhr.
-
-Portions Copyright (c) 2002-2004 Chris Reinhardt.
-
-All rights reserved. This program is free software; you may redistribute
-it and/or modify it under the same terms as Perl itself.
-
-=head1 SEE ALSO
-
-L<perl(1)>, L<Net::DNS>, L<Net::DNS::Resolver>, L<Net::DNS::Packet>,
-L<Net::DNS::Header>, L<Net::DNS::Question>, L<Net::DNS::RR>,
-RFC 2782
-
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/CNAME.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/CNAME.pm
deleted file mode 100644
index d74a816beb1..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/CNAME.pm
+++ /dev/null
@@ -1,97 +0,0 @@
-package Net::DNS::RR::CNAME;
-#
-# $Id: CNAME.pm 632 2007-03-12 13:24:21Z olaf $
-#
-use strict;
-BEGIN {
- eval { require bytes; }
-}
-
-use vars qw(@ISA $VERSION);
-
-@ISA = qw(Net::DNS::RR);
-$VERSION = (qw$LastChangedRevision: 632 $)[1];
-
-sub new {
- my ($class, $self, $data, $offset) = @_;
-
- if ($self->{"rdlength"} > 0) {
- ($self->{"cname"}) = Net::DNS::Packet::dn_expand($data, $offset);
- }
-
- return bless $self, $class;
-}
-
-sub new_from_string {
- my ($class, $self, $string) = @_;
-
- if ($string) {
- $string =~ s/\.+$//;
- $self->{"cname"} = $string;
- }
-
- return bless $self, $class;
-}
-
-sub rdatastr {
- my $self = shift;
-
- return $self->{"cname"} ? "$self->{cname}." : '';
-}
-
-sub rr_rdata {
- my ($self, $packet, $offset) = @_;
- my $rdata = "";
-
- if (exists $self->{"cname"}) {
- $rdata = $packet->dn_comp($self->{"cname"}, $offset);
- }
-
- return $rdata;
-}
-
-# rdata contains a compressed domainname... we should not have that.
-sub _canonicalRdata {
- my ($self) = @_;
- return $self->_name2wire(lc($self->{"cname"}));
-}
-
-1;
-__END__
-
-=head1 NAME
-
-Net::DNS::RR::CNAME - DNS CNAME resource record
-
-=head1 SYNOPSIS
-
-C<use Net::DNS::RR>;
-
-=head1 DESCRIPTION
-
-Class for DNS Canonical Name (CNAME) resource records.
-
-=head1 METHODS
-
-=head2 cname
-
- print "cname = ", $rr->cname, "\n";
-
-Returns the RR's canonical name.
-
-=head1 COPYRIGHT
-
-Copyright (c) 1997-2002 Michael Fuhr.
-
-Portions Copyright (c) 2002-2004 Chris Reinhardt.
-
-All rights reserved. This program is free software; you may redistribute
-it and/or modify it under the same terms as Perl itself.
-
-=head1 SEE ALSO
-
-L<perl(1)>, L<Net::DNS>, L<Net::DNS::Resolver>, L<Net::DNS::Packet>,
-L<Net::DNS::Header>, L<Net::DNS::Question>, L<Net::DNS::RR>,
-RFC 1035 Section 3.3.1
-
-=cut
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/DNAME.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/DNAME.pm
deleted file mode 100644
index c64eea25d14..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/DNAME.pm
+++ /dev/null
@@ -1,90 +0,0 @@
-package Net::DNS::RR::DNAME;
-#
-# $Id: DNAME.pm 388 2005-06-22 10:06:05Z olaf $
-#
-use strict;
-BEGIN {
- eval { require bytes; }
-}
-use vars qw(@ISA $VERSION);
-
-@ISA = qw(Net::DNS::RR);
-$VERSION = (qw$LastChangedRevision: 388 $)[1];
-
-sub new {
- my ($class, $self, $data, $offset) = @_;
-
- if ($self->{"rdlength"} > 0) {
- ($self->{"dname"}) = Net::DNS::Packet::dn_expand($data, $offset);
- }
-
- return bless $self, $class;
-}
-
-sub new_from_string {
- my ($class, $self, $string) = @_;
-
- if ($string) {
- $string =~ s/\.+$//;
- $self->{"dname"} = $string;
- }
-
- return bless $self, $class;
-}
-
-sub rdatastr {
- my $self = shift;
-
- return $self->{"dname"} ? "$self->{dname}." : '';
-}
-
-sub rr_rdata {
- my ($self, $packet, $offset) = @_;
- my $rdata = "";
-
- if (exists $self->{"dname"}) {
- $rdata = $packet->dn_comp($self->{"dname"}, $offset);
- }
-
- return $rdata;
-}
-
-1;
-__END__
-
-=head1 NAME
-
-Net::DNS::RR::DNAME - DNS DNAME resource record
-
-=head1 SYNOPSIS
-
-C<use Net::DNS::RR>;
-
-=head1 DESCRIPTION
-
-Class for DNS Non-Terminal Name Redirection (DNAME) resource records.
-
-=head1 METHODS
-
-=head2 dname
-
- print "dname = ", $rr->dname, "\n";
-
-Returns the DNAME target.
-
-=head1 COPYRIGHT
-
-Copyright (c) 1997-2002 Michael Fuhr.
-
-Portions Copyright (c) 2002-2004 Chris Reinhardt.
-
-All rights reserved. This program is free software; you may redistribute
-it and/or modify it under the same terms as Perl itself.
-
-=head1 SEE ALSO
-
-L<perl(1)>, L<Net::DNS>, L<Net::DNS::Resolver>, L<Net::DNS::Packet>,
-L<Net::DNS::Header>, L<Net::DNS::Question>, L<Net::DNS::RR>,
-RFC 2672
-
-=cut
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/EID.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/EID.pm
deleted file mode 100644
index f46f584ecb5..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/EID.pm
+++ /dev/null
@@ -1,63 +0,0 @@
-package Net::DNS::RR::EID;
-#
-# $Id: EID.pm 388 2005-06-22 10:06:05Z olaf $
-#
-use strict;
-BEGIN {
- eval { require bytes; }
-}
-use vars qw(@ISA $VERSION);
-
-@ISA = qw(Net::DNS::RR);
-$VERSION = (qw$LastChangedRevision: 388 $)[1];
-
-sub new {
- my ($class, $self, $data, $offset) = @_;
- return bless $self, $class;
-}
-
-1;
-__END__
-
-=head1 NAME
-
-Net::DNS::RR::EID - DNS EID resource record
-
-=head1 SYNOPSIS
-
-C<use Net::DNS::RR>;
-
-=head1 DESCRIPTION
-
-Class for DNS Endpoint Identifier (EID) resource records.
-
-=head1 METHODS
-
-=head2 rdlength
-
- print "rdlength = ", $rr->rdlength, "\n";
-
-Returns the length of the record's data section.
-
-=head2 rdata
-
- $rdata = $rr->rdata;
-
-Returns the record's data section as binary data.
-
-=head1 COPYRIGHT
-
-Copyright (c) 1997-2002 Michael Fuhr.
-
-Portions Copyright (c) 2002-2004 Chris Reinhardt.
-
-All rights reserved. This program is free software; you may redistribute
-it and/or modify it under the same terms as Perl itself.
-
-=head1 SEE ALSO
-
-L<perl(1)>, L<Net::DNS>, L<Net::DNS::Resolver>, L<Net::DNS::Packet>,
-L<Net::DNS::Header>, L<Net::DNS::Question>, L<Net::DNS::RR>,
-draft-ietf-nimrod-dns-I<xx>.txt
-
-=cut
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/HINFO.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/HINFO.pm
deleted file mode 100644
index b062a4371be..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/HINFO.pm
+++ /dev/null
@@ -1,125 +0,0 @@
-package Net::DNS::RR::HINFO;
-#
-# $Id: HINFO.pm 639 2007-05-25 12:00:15Z olaf $
-#
-use strict;
-BEGIN {
- eval { require bytes; }
-}
-use vars qw(@ISA $VERSION);
-use Net::DNS::RR::TXT;
-
-@ISA = qw(Net::DNS::RR Net::DNS::RR::TXT);
-$VERSION = (qw$LastChangedRevision: 639 $)[1];
-
-sub new {
- my ($class, $self, $data, $offset) = @_;
-
- if ($self->{"rdlength"} > 0) {
- my ($cpu, $os, $len);
-
- ($len) = unpack("\@$offset C", $$data);
- ++$offset;
- $cpu = substr($$data, $offset, $len);
- $offset += $len;
-
- ($len) = unpack("\@$offset C", $$data);
- ++$offset;
- $os = substr($$data, $offset, $len);
- $offset += $len;
-
- $self->{"cpu"} = $cpu;
- $self->{"os"} = $os;
- }
-
- return bless $self, $class;
-}
-
-sub new_from_string {
- my ( $class, $self, $rdata_string ) = @_ ;
-
- bless $self, $class;
-
- $self->_build_char_str_list($rdata_string);
- my @elements= $self->char_str_list();
- if (@elements==2){
-
-
- $self->{"cpu"} = $elements[0];
- $self->{"os"} = $elements[1];
- }else{
- return;
- }
-
-
- return bless $self, $class;
-}
-
-sub rdatastr {
- my $self = shift;
-
- return $self->{"cpu"}
- ? qq("$self->{cpu}" "$self->{os}")
- : '';
-}
-
-sub rr_rdata {
- my $self = shift;
- my $rdata = "";
-
- if (exists $self->{"cpu"}) {
- $rdata .= pack("C", length $self->{"cpu"});
- $rdata .= $self->{"cpu"};
-
- $rdata .= pack("C", length $self->{"os"});
- $rdata .= $self->{"os"};
- }
-
- return $rdata;
-}
-
-1;
-__END__
-
-=head1 NAME
-
-Net::DNS::RR::HINFO - DNS HINFO resource record
-
-=head1 SYNOPSIS
-
-C<use Net::DNS::RR>;
-
-=head1 DESCRIPTION
-
-Class for DNS Host Information (HINFO) resource records.
-
-=head1 METHODS
-
-=head2 cpu
-
- print "cpu = ", $rr->cpu, "\n";
-
-Returns the CPU type for this RR.
-
-=head2 os
-
- print "os = ", $rr->os, "\n";
-
-Returns the operating system type for this RR.
-
-=head1 COPYRIGHT
-
-Copyright (c) 1997-2002 Michael Fuhr.
-Portions Copyright (c) 2002-2004 Chris Reinhardt
-Portions Copyright (c) 2007 NLnet Labs
-
-All rights reserved. This program is free software; you may redistribute
-it and/or modify it under the same terms as Perl itself.
-
-=head1 SEE ALSO
-
-L<perl(1)>, L<Net::DNS>, L<Net::DNS::Resolver>, L<Net::DNS::Packet>,
-L<Net::DNS::Header>, L<Net::DNS::Question>, L<Net::DNS::RR>,
-RFC 1035 Section 3.3.2
-
-=cut
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/IPSECKEY.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/IPSECKEY.pm
deleted file mode 100644
index dff03952617..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/IPSECKEY.pm
+++ /dev/null
@@ -1,237 +0,0 @@
-package Net::DNS::RR::IPSECKEY;
-
-
-#
-# $Id: IPSECKEY.pm 654 2007-06-20 15:02:50Z olaf $
-#
-use strict;
-BEGIN {
- eval { require bytes; }
-}
-use vars qw(@ISA $VERSION );
-use Socket;
-
-use MIME::Base64;
-
-$VERSION = (qw$LastChangedRevision: 654 $)[1];
-
-@ISA = qw(Net::DNS::RR);
-
-
-#my %gatetype = (
-# 0 => "No gateway is present.",
-# 1 => "A 4-byte IPv4 address is present.",
-# 2 => "A 16-byte IPv6 address is present.",
-# 3 => "A wire-encoded domain name is present.",
-# );
-
-#my %algtype = (
-# RSA => 1,
-# DSA => 2,
-#);
-
-#my %fingerprinttype = (
-# 'SHA-1' => 1,
-#);
-
-#my %fingerprinttypebyval = reverse %fingerprinttype;
-#my %gatetypebyval= reverse %gatetype;
-#my %algtypebyval = reverse %algtype;
-
-
-sub new {
- my ($class, $self, $data, $offset) = @_;
-
- my $offsettoprec = $offset;
- my $offsettogatetype = $offset+1;
- my $offsettoalgor = $offset+2;
- my $offsettogateway = $offset+3;
- my $offsettopubkey;
-
- $self->{'precedence'} = unpack('C', substr($$data, $offsettoprec, 1));
- $self->{'gatetype'} = unpack('C', substr($$data, $offsettogatetype, 1));
- $self->{'algorithm'} = unpack('C', substr($$data, $offsettoalgor, 1));
-
- if ($self->{'gatetype'}==0){
- $self->{'gateway'}='.';
- $offsettopubkey= $offsettogateway;
- }elsif($self->{'gatetype'}==1){
- $self->{'gateway'} = inet_ntoa(substr($$data, $offsettogateway, 4));
- $offsettopubkey= $offsettogateway+4;
- }elsif($self->{'gatetype'}==2){
- $offsettopubkey= $offsettogateway+16;
- my @addr = unpack("\@$offsettogateway n8", $$data);
- $self->{'gateway'} = sprintf("%x:%x:%x:%x:%x:%x:%x:%x", @addr);
- }elsif($self->{'gatetype'}==3){
- ($self->{'gateway'}, $offsettopubkey) = Net::DNS::Packet::dn_expand($data, $offsettogateway);
-
- }else{
- die "Could not parse packet, no known gateway type (".$self->{'gatetype'}.")";
- }
- my($pubmaterial)=substr($$data, $offsettopubkey,
- ($self->{"rdlength"}-$offsettopubkey+$offset));
-
- $self->{"pubbin"}=$pubmaterial;
-
- return bless $self, $class;
-}
-
-
-
-sub new_from_string {
- my ($class, $self, $string) = @_;
- if ($string && ($string =~ /^(\d+)\s+(\d)\s+(\d)\s+(\S+)\s+(\S+)$/)) {
- $self->{"precedence"} = $1;
- $self->{"gatetype"} = $2;
- $self->{"algorithm"} = $3;
- if ($self->{"gatetype"}==2){
- # Using the AAAA.pm parsing functionality.
- my $AAAA=Net::DNS::RR->new("FOO AAAA ".$4);
- $self->{"gateway"}=$AAAA->rdatastr;
- }else
- {
- $self->{"gateway"}= $4;
- }
- $self->{"pubkey"}= $5;
- }
-
-
- return bless $self, $class;
-}
-
-
-sub pubkey {
- my $self=shift;
-
- $self->{"pubkey"}= encode_base64($self->{"pubbin"},"") unless defined $self->{"pubkey"};
-
- return $self->{"pubkey"};
-}
-
-
-sub pubbin {
- my $self=shift;
- $self->{"pubbin"}= decode_base64($self->{"pubkey"}) unless defined $self->{"pubbin"};
-
- return $self->{"pubbin"};
-}
-
-
-sub rdatastr {
- my $self = shift;
- my $rdatastr = '';
- return "" unless defined $self->{precedence};
- $rdatastr .= $self->{"precedence"} . " ". $self->{"gatetype"} . " " .
- $self->{"algorithm"}. " ";
- if ($self->{"gatetype"}==0){
- $rdatastr .= ". ";
- }else{
- $rdatastr .= $self->{"gateway"}. " ";
- }
- $rdatastr .= $self->pubkey();
-
- return $rdatastr;
-}
-
-sub rr_rdata {
- my $self = shift;
- my $rdata = "";
- if (exists $self->{"precedence"}) {
- $rdata .= pack("C", $self->{"precedence"});
- $rdata .= pack("C", $self->{"gatetype"});
- $rdata .= pack("C", $self->{"algorithm"});
- if ($self->{"gatetype"}==1 ){
- $rdata .= inet_aton($self->{"gateway"});
- }elsif($self->{"gatetype"}==2){
- my @addr = split(/:/, $self->{"gateway"});
- $rdata .= pack("n8", map { hex $_ } @addr);
- }elsif($self->{"gatetype"}==3){
- # No Compression _name2wire will do.
- $rdata .= $self->_name2wire($self->{"gateway"});
- }
- $rdata .= $self->pubbin();
- }
-
- return $rdata;
-
-}
-
-
-
-
-
-1;
-
-
-=head1 NAME
-
-Net::DNS::RR::IPSECKEY - DNS IPSECKEY resource record
-
-=head1 SYNOPSIS
-
-C<use Net::DNS::RR>;
-
-=head1 DESCRIPTION
-
-CLASS for the IPSECKEY RR.
-
-=head1 METHODS
-
-In addition to the regular methods
-
-
-=head2 algorithm
-
-Returns the RR's algorithm field in decimal representation
-
- 1 = RSA
- 2 = DSA
-
-=head2 precedence
-
-Returns the presedence
-
-=head2 gatetype
-
-Returns the gatetype.
-
- 0 "No gateway is present.",
- 1 "A 4-byte IPv4 address is present.",
- 2 "A 16-byte IPv6 address is present.",
- 3 "A wire-encoded domain name is present.",
-
-=head2 gateway
-
-Returns the gateway in the relevant string notation.
-
-=head2 pubkey
-
-Returns the public key in base64 notation
-
-=head2 pubbin
-
-Returns the binary public key material in a string.
-
-=head1 TODO
-
-Check on validity of algorithm and gatetype.
-
-=head1 COPYRIGHT
-
-Copyright (c) 2007 NLnet LAbs, Olaf Kolkman.
-
-"All rights reserved, This program is free software; you may redistribute it
-and/or modify it under the same terms as Perl itself.
-
-=head1 SEE ALSO
-
-L<perl(1)>, L<Net::DNS>, L<Net::DNS::Resolver>, L<Net::DNS::Packet>,
-L<Net::DNS::Header>, L<Net::DNS::Question>, L<Net::DNS::RR>,
-draft-ietf-dnssext-delegation-signer
-
-=cut
-
-
-
-
-
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/ISDN.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/ISDN.pm
deleted file mode 100644
index 117e178b43b..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/ISDN.pm
+++ /dev/null
@@ -1,129 +0,0 @@
-package Net::DNS::RR::ISDN;
-#
-# $Id: ISDN.pm 388 2005-06-22 10:06:05Z olaf $
-#
-use strict;
-BEGIN {
- eval { require bytes; }
-}
-use vars qw(@ISA $VERSION);
-
-@ISA = qw(Net::DNS::RR);
-$VERSION = (qw$LastChangedRevision: 388 $)[1];
-
-sub new {
- my ($class, $self, $data, $offset) = @_;
-
- if ($self->{"rdlength"} > 0) {
- my ($address, $sa, $len);
-
- ($len) = unpack("\@$offset C", $$data);
- ++$offset;
- $address = substr($$data, $offset, $len);
- $offset += $len;
-
- if ($len + 1 < $self->{"rdlength"}) {
- ($len) = unpack("\@$offset C", $$data);
- ++$offset;
- $sa = substr($$data, $offset, $len);
- $offset += $len;
- }
- else {
- $sa = "";
- }
-
- $self->{"address"} = $address;
- $self->{"sa"} = $sa;
- }
-
- return bless $self, $class;
-}
-
-sub new_from_string {
- my ($class, $self, $string) = @_;
-
- if ($string && $string =~ /^['"](.*?)['"](.*)/s) {
- $self->{"address"} = $1;
- my $rest = $2;
-
- if ($rest =~ /^\s+['"](.*?)['"]$/) {
- $self->{"sa"} = $1;
- }
- else {
- $self->{"sa"} = "";
- }
- }
-
- return bless $self, $class;
-}
-
-sub rdatastr {
- my $self = shift;
-
- return $self->{"address"}
- ? qq("$self->{address}" "$self->{sa}")
- : '';
-}
-
-sub rr_rdata {
- my $self = shift;
- my $rdata = "";
-
- if (exists $self->{"address"}) {
- $rdata .= pack("C", length $self->{"address"});
- $rdata .= $self->{"address"};
-
- if ($self->{"sa"}) {
- $rdata .= pack("C", length $self->{"sa"});
- $rdata .= $self->{"sa"};
- }
- }
-
- return $rdata;
-}
-
-1;
-__END__
-
-=head1 NAME
-
-Net::DNS::RR::ISDN - DNS ISDN resource record
-
-=head1 SYNOPSIS
-
-C<use Net::DNS::RR>;
-
-=head1 DESCRIPTION
-
-Class for DNS ISDN resource records.
-
-=head1 METHODS
-
-=head2 address
-
- print "address = ", $rr->address, "\n";
-
-Returns the RR's address field.
-
-=head2 sa
-
- print "subaddress = ", $rr->sa, "\n";
-
-Returns the RR's subaddress field.
-
-=head1 COPYRIGHT
-
-Copyright (c) 1997-2002 Michael Fuhr.
-
-Portions Copyright (c) 2002-2004 Chris Reinhardt.
-
-All rights reserved. This program is free software; you may redistribute
-it and/or modify it under the same terms as Perl itself.
-
-=head1 SEE ALSO
-
-L<perl(1)>, L<Net::DNS>, L<Net::DNS::Resolver>, L<Net::DNS::Packet>,
-L<Net::DNS::Header>, L<Net::DNS::Question>, L<Net::DNS::RR>,
-RFC 1183 Section 3.2
-
-=cut
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/LOC.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/LOC.pm
deleted file mode 100644
index 61b84f5f1f5..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/LOC.pm
+++ /dev/null
@@ -1,363 +0,0 @@
-package Net::DNS::RR::LOC;
-#
-# $Id: LOC.pm 388 2005-06-22 10:06:05Z olaf $
-#
-use strict;
-BEGIN {
- eval { require bytes; }
-}
-use vars qw(
- @ISA $VERSION @poweroften $reference_alt
- $reference_latlon $conv_sec $conv_min $conv_deg
- $default_min $default_sec $default_size
- $default_horiz_pre $default_vert_pre
-);
-
-@ISA = qw(Net::DNS::RR);
-$VERSION = (qw$LastChangedRevision: 388 $)[1];
-
-# Powers of 10 from 0 to 9 (used to speed up calculations).
-@poweroften = (1, 10, 100, 1_000, 10_000, 100_000, 1_000_000,
- 10_000_000, 100_000_000, 1_000_000_000);
-
-# Reference altitude in centimeters (see RFC 1876).
-$reference_alt = 100_000 * 100;
-
-# Reference lat/lon (see RFC 1876).
-$reference_latlon = 2**31;
-
-# Conversions to/from thousandths of a degree.
-$conv_sec = 1000;
-$conv_min = 60 * $conv_sec;
-$conv_deg = 60 * $conv_min;
-
-# Defaults (from RFC 1876, Section 3).
-$default_min = 0;
-$default_sec = 0;
-$default_size = 1;
-$default_horiz_pre = 10_000;
-$default_vert_pre = 10;
-
-sub new {
- my ($class, $self, $data, $offset) = @_;
-
- if ($self->{"rdlength"} > 0) {
- my ($version) = unpack("\@$offset C", $$data);
- ++$offset;
-
- $self->{"version"} = $version;
-
- if ($version == 0) {
- my ($size) = unpack("\@$offset C", $$data);
- $size = precsize_ntoval($size);
- ++$offset;
-
- my ($horiz_pre) = unpack("\@$offset C", $$data);
- $horiz_pre = precsize_ntoval($horiz_pre);
- ++$offset;
-
- my ($vert_pre) = unpack("\@$offset C", $$data);
- $vert_pre = precsize_ntoval($vert_pre);
- ++$offset;
-
- my ($latitude) = unpack("\@$offset N", $$data);
- $offset += Net::DNS::INT32SZ();
-
- my ($longitude) = unpack("\@$offset N", $$data);
- $offset += Net::DNS::INT32SZ();
-
- my ($altitude) = unpack("\@$offset N", $$data);
- $offset += Net::DNS::INT32SZ();
-
- $self->{"size"} = $size;
- $self->{"horiz_pre"} = $horiz_pre;
- $self->{"vert_pre"} = $vert_pre;
- $self->{"latitude"} = $latitude;
- $self->{"longitude"} = $longitude;
- $self->{"altitude"} = $altitude;
- }
- else {
- # What to do for unsupported versions?
- }
- }
-
- return bless $self, $class;
-}
-
-sub new_from_string {
- my ($class, $self, $string) = @_;
-
- if ($string &&
- $string =~ /^ (\d+) \s+ # deg lat
- ((\d+) \s+)? # min lat
- (([\d.]+) \s+)? # sec lat
- (N|S) \s+ # hem lat
- (\d+) \s+ # deg lon
- ((\d+) \s+)? # min lon
- (([\d.]+) \s+)? # sec lon
- (E|W) \s+ # hem lon
- (-?[\d.]+) m? # altitude
- (\s+ ([\d.]+) m?)? # size
- (\s+ ([\d.]+) m?)? # horiz precision
- (\s+ ([\d.]+) m?)? # vert precision
- /ix) {
-
- # What to do for other versions?
- my $version = 0;
-
- my ($latdeg, $latmin, $latsec, $lathem) = ($1, $3, $5, $6);
- my ($londeg, $lonmin, $lonsec, $lonhem) = ($7, $9, $11, $12);
- my ($alt, $size, $horiz_pre, $vert_pre) = ($13, $15, $17, $19);
-
- $latmin = $default_min unless $latmin;
- $latsec = $default_sec unless $latsec;
- $lathem = uc($lathem);
-
- $lonmin = $default_min unless $lonmin;
- $lonsec = $default_sec unless $lonsec;
- $lonhem = uc($lonhem);
-
- $size = $default_size unless $size;
- $horiz_pre = $default_horiz_pre unless $horiz_pre;
- $vert_pre = $default_vert_pre unless $vert_pre;
-
- $self->{"version"} = $version;
- $self->{"size"} = $size * 100;
- $self->{"horiz_pre"} = $horiz_pre * 100;
- $self->{"vert_pre"} = $vert_pre * 100;
- $self->{"latitude"} = dms2latlon($latdeg, $latmin, $latsec,
- $lathem);
- $self->{"longitude"} = dms2latlon($londeg, $lonmin, $lonsec,
- $lonhem);
- $self->{"altitude"} = $alt * 100 + $reference_alt;
- }
-
- return bless $self, $class;
-}
-
-sub rdatastr {
- my $self = shift;
- my $rdatastr;
-
- if (exists $self->{"version"}) {
- if ($self->{"version"} == 0) {
- my $lat = $self->{"latitude"};
- my $lon = $self->{"longitude"};
- my $altitude = $self->{"altitude"};
- my $size = $self->{"size"};
- my $horiz_pre = $self->{"horiz_pre"};
- my $vert_pre = $self->{"vert_pre"};
-
- $altitude = ($altitude - $reference_alt) / 100;
- $size /= 100;
- $horiz_pre /= 100;
- $vert_pre /= 100;
-
- $rdatastr = latlon2dms($lat, "NS") . " " .
- latlon2dms($lon, "EW") . " " .
- sprintf("%.2fm", $altitude) . " " .
- sprintf("%.2fm", $size) . " " .
- sprintf("%.2fm", $horiz_pre) . " " .
- sprintf("%.2fm", $vert_pre);
- } else {
- $rdatastr = "; version " . $self->{"version"} . " not supported";
- }
- } else {
- $rdatastr = '';
- }
-
- return $rdatastr;
-}
-
-sub rr_rdata {
- my $self = shift;
- my $rdata = "";
-
- if (exists $self->{"version"}) {
- $rdata .= pack("C", $self->{"version"});
- if ($self->{"version"} == 0) {
- $rdata .= pack("C3", precsize_valton($self->{"size"}),
- precsize_valton($self->{"horiz_pre"}),
- precsize_valton($self->{"vert_pre"}));
- $rdata .= pack("N3", $self->{"latitude"},
- $self->{"longitude"},
- $self->{"altitude"});
- }
- else {
- # What to do for other versions?
- }
- }
-
- return $rdata;
-}
-
-sub precsize_ntoval {
- my $prec = shift;
-
- my $mantissa = (($prec >> 4) & 0x0f) % 10;
- my $exponent = ($prec & 0x0f) % 10;
- return $mantissa * $poweroften[$exponent];
-}
-
-sub precsize_valton {
- my $val = shift;
-
- my $exponent = 0;
- while ($val >= 10) {
- $val /= 10;
- ++$exponent;
- }
- return (int($val) << 4) | ($exponent & 0x0f);
-}
-
-sub latlon2dms {
- my ($rawmsec, $hems) = @_;
-
- # Tried to use modulus here, but Perl dumped core if
- # the value was >= 2**31.
-
- my ($abs, $deg, $min, $sec, $msec, $hem);
-
- $abs = abs($rawmsec - $reference_latlon);
- $deg = int($abs / $conv_deg);
- $abs -= $deg * $conv_deg;
- $min = int($abs / $conv_min);
- $abs -= $min * $conv_min;
- $sec = int($abs / $conv_sec);
- $abs -= $sec * $conv_sec;
- $msec = $abs;
-
- $hem = substr($hems, ($rawmsec >= $reference_latlon ? 0 : 1), 1);
-
- return sprintf("%d %02d %02d.%03d %s", $deg, $min, $sec, $msec, $hem);
-}
-
-sub dms2latlon {
- my ($deg, $min, $sec, $hem) = @_;
- my ($retval);
-
- $retval = ($deg * $conv_deg) + ($min * $conv_min) + ($sec * $conv_sec);
- $retval = -$retval if ($hem eq "S") || ($hem eq "W");
- $retval += $reference_latlon;
- return $retval;
-}
-
-sub latlon {
- my $self = shift;
- my ($retlat, $retlon);
-
- if ($self->{"version"} == 0) {
- $retlat = latlon2deg($self->{"latitude"});
- $retlon = latlon2deg($self->{"longitude"});
- }
- else {
- $retlat = $retlon = undef;
- }
-
- return ($retlat, $retlon);
-}
-
-sub latlon2deg {
- my $rawmsec = shift;
- my $deg;
-
- $deg = ($rawmsec - $reference_latlon) / $conv_deg;
- return $deg;
-}
-
-1;
-__END__
-
-=head1 NAME
-
-Net::DNS::RR::LOC - DNS LOC resource record
-
-=head1 SYNOPSIS
-
-C<use Net::DNS::RR>;
-
-=head1 DESCRIPTION
-
-Class for DNS Location (LOC) resource records. See RFC 1876 for
-details.
-
-=head1 METHODS
-
-=head2 version
-
- print "version = ", $rr->version, "\n";
-
-Returns the version number of the representation; programs should
-always check this. C<Net::DNS> currently supports only version 0.
-
-=head2 size
-
- print "size = ", $rr->size, "\n";
-
-Returns the diameter of a sphere enclosing the described entity,
-in centimeters.
-
-=head2 horiz_pre
-
- print "horiz_pre = ", $rr->horiz_pre, "\n";
-
-Returns the horizontal precision of the data, in centimeters.
-
-=head2 vert_pre
-
- print "vert_pre = ", $rr->vert_pre, "\n";
-
-Returns the vertical precision of the data, in centimeters.
-
-=head2 latitude
-
- print "latitude = ", $rr->latitude, "\n";
-
-Returns the latitude of the center of the sphere described by
-the C<size> method, in thousandths of a second of arc. 2**31
-represents the equator; numbers above that are north latitude.
-
-=head2 longitude
-
- print "longitude = ", $rr->longitude, "\n";
-
-Returns the longitude of the center of the sphere described by
-the C<size> method, in thousandths of a second of arc. 2**31
-represents the prime meridian; numbers above that are east
-longitude.
-
-=head2 latlon
-
- ($lat, $lon) = $rr->latlon;
- system("xearth", "-pos", "fixed $lat $lon");
-
-Returns the latitude and longitude as floating-point degrees.
-Positive numbers represent north latitude or east longitude;
-negative numbers represent south latitude or west longitude.
-
-=head2 altitude
-
- print "altitude = ", $rr->altitude, "\n";
-
-Returns the altitude of the center of the sphere described by
-the C<size> method, in centimeters, from a base of 100,000m
-below the WGS 84 reference spheroid used by GPS.
-
-=head1 COPYRIGHT
-
-Copyright (c) 1997-2002 Michael Fuhr.
-
-Portions Copyright (c) 2002-2004 Chris Reinhardt.
-
-All rights reserved. This program is free software; you may redistribute
-it and/or modify it under the same terms as Perl itself.
-Some of the code and documentation is based on RFC 1876 and on code
-contributed by Christopher Davis.
-
-=head1 SEE ALSO
-
-L<perl(1)>, L<Net::DNS>, L<Net::DNS::Resolver>, L<Net::DNS::Packet>,
-L<Net::DNS::Header>, L<Net::DNS::Question>, L<Net::DNS::RR>,
-RFC 1876
-
-=cut
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/MB.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/MB.pm
deleted file mode 100644
index e6b33eed0ae..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/MB.pm
+++ /dev/null
@@ -1,99 +0,0 @@
-package Net::DNS::RR::MB;
-#
-# $Id: MB.pm 632 2007-03-12 13:24:21Z olaf $
-#
-use strict;
-BEGIN {
- eval { require bytes; }
-}
-use vars qw(@ISA $VERSION);
-
-@ISA = qw(Net::DNS::RR);
-$VERSION = (qw$LastChangedRevision: 632 $)[1];
-
-sub new {
- my ($class, $self, $data, $offset) = @_;
-
- if ($self->{"rdlength"} > 0) {
- ($self->{"madname"}) = Net::DNS::Packet::dn_expand($data, $offset);
- }
-
- return bless $self, $class;
-}
-
-sub new_from_string {
- my ($class, $self, $string) = @_;
-
- if ($string) {
- $string =~ s/\.+$//;
- $self->{"madname"} = $string;
- }
-
- return bless $self, $class;
-}
-
-sub rdatastr {
- my $self = shift;
-
- return $self->{"madname"} ? "$self->{madname}." : '';
-}
-
-sub rr_rdata {
- my ($self, $packet, $offset) = @_;
- my $rdata = "";
-
- if (exists $self->{"madname"}) {
- $rdata .= $packet->dn_comp($self->{"madname"}, $offset);
- }
-
- return $rdata;
-}
-
-sub _canonicalRdata {
- my $self=shift;
- my $rdata = "";
- if (exists $self->{"madname"}) {
- $rdata .= $self->_name2wire(lc($self->{"madname"}));
- }
- return $rdata;
-}
-
-
-1;
-__END__
-
-=head1 NAME
-
-Net::DNS::RR::MB - DNS MB resource record
-
-=head1 SYNOPSIS
-
-C<use Net::DNS::RR>;
-
-=head1 DESCRIPTION
-
-Class for DNS Mailbox (MB) resource records.
-
-=head1 METHODS
-
-=head2 madname
-
- print "madname = ", $rr->madname, "\n";
-
-Returns the domain name of the host which has the specified mailbox.
-
-=head1 COPYRIGHT
-
-Copyright (c) 1997-2002 Michael Fuhr.
-
-Portions Copyright (c) 2002-2004 Chris Reinhardt.
-
-All rights reserved. This program is free software; you may redistribute
-it and/or modify it under the same terms as Perl itself.
-=head1 SEE ALSO
-
-L<perl(1)>, L<Net::DNS>, L<Net::DNS::Resolver>, L<Net::DNS::Packet>,
-L<Net::DNS::Header>, L<Net::DNS::Question>, L<Net::DNS::RR>,
-RFC 1035 Section 3.3.3
-
-=cut
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/MG.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/MG.pm
deleted file mode 100644
index c4950e20048..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/MG.pm
+++ /dev/null
@@ -1,100 +0,0 @@
-package Net::DNS::RR::MG;
-#
-# $Id: MG.pm 632 2007-03-12 13:24:21Z olaf $
-#
-use strict;
-BEGIN {
- eval { require bytes; }
-}
-use vars qw(@ISA $VERSION);
-
-@ISA = qw(Net::DNS::RR);
-$VERSION = (qw$LastChangedRevision: 632 $)[1];
-
-sub new {
- my ($class, $self, $data, $offset) = @_;
-
- if ($self->{"rdlength"} > 0) {
- ($self->{"mgmname"}) = Net::DNS::Packet::dn_expand($data, $offset);
- }
-
- return bless $self, $class;
-}
-
-sub new_from_string {
- my ($class, $self, $string) = @_;
-
- if ($string) {
- $string =~ s/\.+$//;
- $self->{"mgmname"} = $string;
- }
-
- return bless $self, $class;
-}
-
-sub rdatastr {
- my $self = shift;
-
- return exists $self->{"mgmname"} ? "$self->{mgmname}." : '';
-}
-
-sub rr_rdata {
- my ($self, $packet, $offset) = @_;
- my $rdata = "";
-
- if (exists $self->{"mgmname"}) {
- $rdata .= $packet->dn_comp($self->{"mgmname"}, $offset);
- }
-
- return $rdata;
-}
-
-
-sub _canonicalRdata {
- my $self=shift;
- my $rdata = "";
- if (exists $self->{"mgmname"}) {
- $rdata .= $self->_name2wire(lc($self->{"mgmname"}));
- }
- return $rdata;
-}
-
-
-1;
-__END__
-
-=head1 NAME
-
-Net::DNS::RR::MG - DNS MG resource record
-
-=head1 SYNOPSIS
-
-C<use Net::DNS::RR>;
-
-=head1 DESCRIPTION
-
-Class for DNS Mail Group (MG) resource records.
-
-=head1 METHODS
-
-=head2 mgmname
-
- print "mgmname = ", $rr->mgmname, "\n";
-
-Returns the RR's mailbox field.
-
-=head1 COPYRIGHT
-
-Copyright (c) 1997-2002 Michael Fuhr.
-
-Portions Copyright (c) 2002-2004 Chris Reinhardt.
-
-All rights reserved. This program is free software; you may redistribute
-it and/or modify it under the same terms as Perl itself.
-=head1 SEE ALSO
-
-L<perl(1)>, L<Net::DNS>, L<Net::DNS::Resolver>, L<Net::DNS::Packet>,
-L<Net::DNS::Header>, L<Net::DNS::Question>, L<Net::DNS::RR>,
-RFC 1035 Section 3.3.6
-
-=cut
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/MINFO.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/MINFO.pm
deleted file mode 100644
index 3a3885b44fb..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/MINFO.pm
+++ /dev/null
@@ -1,118 +0,0 @@
-package Net::DNS::RR::MINFO;
-#
-# $Id: MINFO.pm 632 2007-03-12 13:24:21Z olaf $
-#
-use strict;
-BEGIN {
- eval { require bytes; }
-}
-use vars qw(@ISA $VERSION);
-
-@ISA = qw(Net::DNS::RR);
-$VERSION = (qw$LastChangedRevision: 632 $)[1];
-
-sub new {
- my ($class, $self, $data, $offset) = @_;
-
- if ($self->{"rdlength"} > 0) {
- ($self->{"rmailbx"}, $offset) = Net::DNS::Packet::dn_expand($data, $offset);
- ($self->{"emailbx"}, $offset) = Net::DNS::Packet::dn_expand($data, $offset);
- }
-
- return bless $self, $class;
-}
-
-sub new_from_string {
- my ($class, $self, $string) = @_;
-
- if ($string && ($string =~ /^(\S+)\s+(\S+)$/)) {
- $self->{"rmailbx"} = $1;
- $self->{"emailbx"} = $2;
- $self->{"rmailbx"} =~ s/\.+$//;
- $self->{"emailbx"} =~ s/\.+$//;
- }
-
- return bless $self, $class;
-}
-
-sub rdatastr {
- my $self = shift;
-
- return $self->{"rmailbx"}
- ? "$self->{rmailbx}. $self->{emailbx}."
- : '';
-}
-
-sub rr_rdata {
- my ($self, $packet, $offset) = @_;
- my $rdata = "";
-
- if (exists $self->{"rmailbx"}) {
- $rdata .= $packet->dn_comp($self->{"rmailbx"}, $offset);
-
- $rdata .= $packet->dn_comp($self->{"emailbx"},
- $offset + length $rdata);
- }
-
- return $rdata;
-}
-
-
-sub _canonicalRdata {
- my ($self, $packet, $offset) = @_;
- my $rdata = "";
-
- if (exists $self->{"rmailbx"}) {
- $rdata .= $self->_name2wire(lc($self->{"rmailbx"}));
- $rdata .= $self->_name2wire(lc($self->{"emailbx"}));
- }
-
- return $rdata;
-}
-
-
-1;
-__END__
-
-=head1 NAME
-
-Net::DNS::RR::MINFO - DNS MINFO resource record
-
-=head1 SYNOPSIS
-
-C<use Net::DNS::RR>;
-
-=head1 DESCRIPTION
-
-Class for DNS Mailbox Information (MINFO) resource records.
-
-=head1 METHODS
-
-=head2 rmailbx
-
- print "rmailbx = ", $rr->rmailbx, "\n";
-
-Returns the RR's responsible mailbox field. See RFC 1035.
-
-=head2 emailbx
-
- print "emailbx = ", $rr->emailbx, "\n";
-
-Returns the RR's error mailbox field.
-
-=head1 COPYRIGHT
-
-Copyright (c) 1997-2002 Michael Fuhr.
-
-Portions Copyright (c) 2002-2004 Chris Reinhardt.
-
-All rights reserved. This program is free software; you may redistribute
-it and/or modify it under the same terms as Perl itself.
-
-=head1 SEE ALSO
-
-L<perl(1)>, L<Net::DNS>, L<Net::DNS::Resolver>, L<Net::DNS::Packet>,
-L<Net::DNS::Header>, L<Net::DNS::Question>, L<Net::DNS::RR>,
-RFC 1035 Section 3.3.7
-
-=cut
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/MR.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/MR.pm
deleted file mode 100644
index 7f7b60d3d16..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/MR.pm
+++ /dev/null
@@ -1,101 +0,0 @@
-package Net::DNS::RR::MR;
-#
-# $Id: MR.pm 632 2007-03-12 13:24:21Z olaf $
-#
-use strict;
-BEGIN {
- eval { require bytes; }
-}
-use vars qw(@ISA $VERSION);
-
-@ISA = qw(Net::DNS::RR);
-$VERSION = (qw$LastChangedRevision: 632 $)[1];
-
-sub new {
- my ($class, $self, $data, $offset) = @_;
-
- if ($self->{"rdlength"} > 0) {
- ($self->{"newname"}) = Net::DNS::Packet::dn_expand($data, $offset);
- }
-
- return bless $self, $class;
-}
-
-sub new_from_string {
- my ($class, $self, $string) = @_;
-
- if ($string) {
- $string =~ s/\.+$//;
- $self->{"newname"} = $string;
- }
-
- return bless $self, $class;
-}
-
-sub rdatastr {
- my $self = shift;
-
- return $self->{"newname"} ? "$self->{newname}." : '';
-}
-
-sub rr_rdata {
- my ($self, $packet, $offset) = @_;
- my $rdata = "";
-
- if (exists $self->{"newname"}) {
- $rdata .= $packet->dn_comp($self->{"newname"}, $offset);
- }
-
- return $rdata;
-}
-
-sub _canonicalRdata {
- my $self=shift;
- my $rdata = "";
- if (exists $self->{"newname"}) {
- $rdata .= $self->_name2wire(lc($self->{"newname"}));
- }
- return $rdata;
-}
-
-
-
-1;
-__END__
-
-=head1 NAME
-
-Net::DNS::RR::MR - DNS MR resource record
-
-=head1 SYNOPSIS
-
-C<use Net::DNS::RR>;
-
-=head1 DESCRIPTION
-
-Class for DNS Mail Rename (MR) resource records.
-
-=head1 METHODS
-
-=head2 newname
-
- print "newname = ", $rr->newname, "\n";
-
-Returns the RR's new name field.
-
-=head1 COPYRIGHT
-
-Copyright (c) 1997-2002 Michael Fuhr.
-
-Portions Copyright (c) 2002-2004 Chris Reinhardt.
-
-All rights reserved. This program is free software; you may redistribute
-it and/or modify it under the same terms as Perl itself.
-
-=head1 SEE ALSO
-
-L<perl(1)>, L<Net::DNS>, L<Net::DNS::Resolver>, L<Net::DNS::Packet>,
-L<Net::DNS::Header>, L<Net::DNS::Question>, L<Net::DNS::RR>,
-RFC 1035 Section 3.3.8
-
-=cut
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/MX.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/MX.pm
deleted file mode 100644
index 31fe499f2c7..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/MX.pm
+++ /dev/null
@@ -1,135 +0,0 @@
-package Net::DNS::RR::MX;
-#
-# $Id: MX.pm 632 2007-03-12 13:24:21Z olaf $
-#
-use strict;
-BEGIN {
- eval { require bytes; }
-}
-use vars qw(@ISA $VERSION);
-
-@ISA = qw(Net::DNS::RR);
-$VERSION = (qw$LastChangedRevision: 632 $)[1];
-
-
-# Highest preference sorted first.
-__PACKAGE__->set_rrsort_func("preference",
- sub {
- my ($a,$b)=($Net::DNS::a,$Net::DNS::b);
- $a->{'preference'} <=> $b->{'preference'}
-}
-);
-
-
-__PACKAGE__->set_rrsort_func("default_sort",
- __PACKAGE__->get_rrsort_func("preference")
-
- );
-
-
-
-sub new {
- my ($class, $self, $data, $offset) = @_;
-
- if ($self->{"rdlength"} > 0) {
- ($self->{"preference"}) = unpack("\@$offset n", $$data);
- $offset += Net::DNS::INT16SZ();
-
- ($self->{"exchange"}) = Net::DNS::Packet::dn_expand($data, $offset);
- }
-
- return bless $self, $class;
-}
-
-sub new_from_string {
- my ($class, $self, $string) = @_;
-
- if ($string && ($string =~ /^(\d+)\s+(\S+)$/)) {
- $self->{"preference"} = $1;
- $self->{"exchange"} = $2;
- $self->{"exchange"} =~ s/\.+$//;;
- }
-
- return bless $self, $class;
-}
-
-sub rdatastr {
- my $self = shift;
-
- return defined $self->{"preference"}
- ? "$self->{preference} $self->{exchange}."
- : '';
-}
-
-sub rr_rdata {
- my ($self, $packet, $offset) = @_;
- my $rdata = "";
-
- if (exists $self->{"preference"}) {
- $rdata .= pack("n", $self->{"preference"});
- $rdata .= $packet->dn_comp($self->{"exchange"},
- $offset + length $rdata);
- }
-
- return $rdata;
-}
-
-sub _canonicalRdata {
- my ($self) = @_;
- my $rdata = "";
-
- if (exists $self->{"preference"}) {
- $rdata .= pack("n", $self->{"preference"});
- $rdata .= $self->_name2wire(lc($self->{"exchange"}))
- }
-
- return $rdata;
-}
-
-
-1;
-__END__
-
-=head1 NAME
-
-Net::DNS::RR::MX - DNS MX resource record
-
-=head1 SYNOPSIS
-
-C<use Net::DNS::RR>;
-
-=head1 DESCRIPTION
-
-Class for DNS Mail Exchanger (MX) resource records.
-
-=head1 METHODS
-
-=head2 preference
-
- print "preference = ", $rr->preference, "\n";
-
-Returns the preference for this mail exchange.
-
-=head2 exchange
-
- print "exchange = ", $rr->exchange, "\n";
-
-Returns name of this mail exchange.
-
-=head1 COPYRIGHT
-
-Copyright (c) 1997-2002 Michael Fuhr.
-
-Portions Copyright (c) 2002-2004 Chris Reinhardt.
-Portions Copyright (c) 2005 Olaf Kolkman NLnet Labs.
-
-All rights reserved. This program is free software; you may redistribute
-it and/or modify it under the same terms as Perl itself.
-
-=head1 SEE ALSO
-
-L<perl(1)>, L<Net::DNS>, L<Net::DNS::Resolver>, L<Net::DNS::Packet>,
-L<Net::DNS::Header>, L<Net::DNS::Question>, L<Net::DNS::RR>,
-RFC 1035 Section 3.3.9
-
-=cut
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/NAPTR.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/NAPTR.pm
deleted file mode 100644
index 1148ec99463..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/NAPTR.pm
+++ /dev/null
@@ -1,210 +0,0 @@
-package Net::DNS::RR::NAPTR;
-#
-# $Id: NAPTR.pm 583 2006-05-03 12:24:18Z olaf $
-#
-use strict;
-BEGIN {
- eval { require bytes; }
-}
-use vars qw(@ISA $VERSION);
-
-@ISA = qw(Net::DNS::RR);
-$VERSION = (qw$LastChangedRevision: 583 $)[1];
-
-
-
-
-__PACKAGE__->set_rrsort_func("order",
- sub {
- my ($a,$b)=($Net::DNS::a,$Net::DNS::b);
- $a->{'order'} <=> $b->{'order'}
- ||
- $a->{'preference'} <=> $b->{'preference'}
-}
-);
-
-
-__PACKAGE__->set_rrsort_func("default_sort",
- __PACKAGE__->get_rrsort_func("order")
-
- );
-
-__PACKAGE__->set_rrsort_func("preference",
- sub {
- my ($a,$b)=($Net::DNS::a,$Net::DNS::b);
- $a->{"preference"} <=> $b->{"preference"}
- ||
- $a->{"order"} <=> $b->{"order"}
-}
-);
-
-
-
-sub new {
- my ($class, $self, $data, $offset) = @_;
-
- if ($self->{"rdlength"} > 0) {
- ($self->{"order"} ) = unpack("\@$offset n", $$data);
- $offset += Net::DNS::INT16SZ();
-
- ($self->{"preference"}) = unpack("\@$offset n", $$data);
- $offset += Net::DNS::INT16SZ();
-
- my ($len) = unpack("\@$offset C", $$data);
- ++$offset;
- ($self->{"flags"}) = unpack("\@$offset a$len", $$data);
- $offset += $len;
-
- $len = unpack("\@$offset C", $$data);
- ++$offset;
- ($self->{"service"}) = unpack("\@$offset a$len", $$data);
- $offset += $len;
-
- $len = unpack("\@$offset C", $$data);
- ++$offset;
- ($self->{"regexp"}) = unpack("\@$offset a$len", $$data);
- $offset += $len;
-
- ($self->{"replacement"}) = Net::DNS::Packet::dn_expand($data, $offset);
- }
-
- return bless $self, $class;
-}
-
-sub new_from_string {
- my ($class, $self, $string) = @_;
-
- if ($string && $string =~ /^ (\d+) \s+
- (\d+) \s+
- ['"] (.*?) ['"] \s+
- ['"] (.*?) ['"] \s+
- ['"] (.*?) ['"] \s+
- (\S+) $/x) {
-
- $self->{"order"} = $1;
- $self->{"preference"} = $2;
- $self->{"flags"} = $3;
- $self->{"service"} = $4;
- $self->{"regexp"} = $5;
- $self->{"replacement"} = $6;
- $self->{"replacement"} =~ s/\.+$//;
- }
-
- return bless $self, $class;
-}
-
-sub rdatastr {
- my $self = shift;
- my $rdatastr;
-
- if (exists $self->{"order"}) {
- $rdatastr = $self->{"order"} . ' ' .
- $self->{"preference"} . ' "' .
- $self->{"flags"} . '" "' .
- $self->{"service"} . '" "' .
- $self->{"regexp"} . '" ' .
- $self->{"replacement"} . '.';
- }
- else {
- $rdatastr = '';
- }
-
- return $rdatastr;
-}
-
-sub rr_rdata {
- my ($self, $packet, $offset) = @_;
- my $rdata = "";
-
- if (exists $self->{"order"}) {
-
- $rdata .= pack("n2", $self->{"order"}, $self->{"preference"});
-
- $rdata .= pack("C", length $self->{"flags"});
- $rdata .= $self->{"flags"};
-
- $rdata .= pack("C", length $self->{"service"});
- $rdata .= $self->{"service"};
-
- $rdata .= pack("C", length $self->{"regexp"});
- $rdata .= $self->{"regexp"};
-
- $rdata .= $self->_name2wire ($self->{"replacement"});
-
- }
-
- return $rdata;
-}
-
-1;
-__END__
-
-=head1 NAME
-
-Net::DNS::RR::NAPTR - DNS NAPTR resource record
-
-=head1 SYNOPSIS
-
-C<use Net::DNS::RR>;
-
-=head1 DESCRIPTION
-
-Class for DNS Naming Authority Pointer (NAPTR) resource records.
-
-=head1 METHODS
-
-=head2 order
-
- print "order = ", $rr->order, "\n";
-
-Returns the order field.
-
-=head2 preference
-
- print "preference = ", $rr->preference, "\n";
-
-Returns the preference field.
-
-=head2 flags
-
- print "flags = ", $rr->flags, "\n";
-
-Returns the flags field.
-
-=head2 service
-
- print "service = ", $rr->service, "\n";
-
-Returns the service field.
-
-=head2 regexp
-
- print "regexp = ", $rr->regexp, "\n";
-
-Returns the regexp field.
-
-=head2 replacement
-
- print "replacement = ", $rr->replacement, "\n";
-
-Returns the replacement field.
-
-=head1 COPYRIGHT
-
-Copyright (c) 1997-2002 Michael Fuhr.
-
-Portions Copyright (c) 2002-2004 Chris Reinhardt.
-Portions Copyright (c) 2005 Olaf Kolkman NLnet Labs.
-
-All rights reserved. This program is free software; you may redistribute
-it and/or modify it under the same terms as Perl itself.
-
-B<Net::DNS::RR::NAPTR> is based on code contributed by Ryan Moats.
-
-=head1 SEE ALSO
-
-L<perl(1)>, L<Net::DNS>, L<Net::DNS::Resolver>, L<Net::DNS::Packet>,
-L<Net::DNS::Header>, L<Net::DNS::Question>, L<Net::DNS::RR>,
-RFC 2168
-
-=cut
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/NIMLOC.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/NIMLOC.pm
deleted file mode 100644
index bec86aebe41..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/NIMLOC.pm
+++ /dev/null
@@ -1,63 +0,0 @@
-package Net::DNS::RR::NIMLOC;
-#
-# $Id: NIMLOC.pm 388 2005-06-22 10:06:05Z olaf $
-#
-use strict;
-BEGIN {
- eval { require bytes; }
-}
-use vars qw(@ISA $VERSION);
-
-@ISA = qw(Net::DNS::RR);
-$VERSION = (qw$LastChangedRevision: 388 $)[1];
-
-sub new {
- my ($class, $self, $data, $offset) = @_;
- return bless $self, $class;
-}
-
-1;
-__END__
-
-=head1 NAME
-
-Net::DNS::RR::NIMLOC - DNS NIMLOC resource record
-
-=head1 SYNOPSIS
-
-C<use Net::DNS::RR>;
-
-=head1 DESCRIPTION
-
-Class for DNS Nimrod Locator (NIMLOC) resource records.
-
-=head1 METHODS
-
-=head2 rdlength
-
- print "rdlength = ", $rr->rdlength, "\n";
-
-Returns the length of the record's data section.
-
-=head2 rdata
-
- $rdata = $rr->rdata;
-
-Returns the record's data section as binary data.
-
-=head1 COPYRIGHT
-
-Copyright (c) 1997-2002 Michael Fuhr.
-
-Portions Copyright (c) 2002-2004 Chris Reinhardt.
-
-All rights reserved. This program is free software; you may redistribute
-it and/or modify it under the same terms as Perl itself.
-
-=head1 SEE ALSO
-
-L<perl(1)>, L<Net::DNS>, L<Net::DNS::Resolver>, L<Net::DNS::Packet>,
-L<Net::DNS::Header>, L<Net::DNS::Question>, L<Net::DNS::RR>,
-draft-ietf-nimrod-dns-I<xx>.txt
-
-=cut
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/NS.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/NS.pm
deleted file mode 100644
index 96f60db7847..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/NS.pm
+++ /dev/null
@@ -1,106 +0,0 @@
-#
-# $Id: NS.pm 707 2008-02-06 22:27:28Z olaf $
-#
-package Net::DNS::RR::NS;
-
-use strict;
-BEGIN {
- eval { require bytes; }
-}
-use vars qw(@ISA $VERSION);
-
-@ISA = qw(Net::DNS::RR);
-$VERSION = (qw$LastChangedRevision: 707 $)[1];
-
-sub new {
- my ($class, $self, $data, $offset) = @_;
-
- if ($self->{"rdlength"} > 0) {
- ($self->{"nsdname"}) = Net::DNS::Packet::dn_expand($data, $offset);
- }
-
- return bless $self, $class;
-}
-
-sub new_from_string {
- my ($class, $self, $string) = @_;
-
- if ($string) {
- $string =~ s/\.+$//;
- $self->{"nsdname"} = $string;
- }
-
- return bless $self, $class;
-}
-
-sub rdatastr {
- my $self = shift;
-
- return $self->{"nsdname"} ? "$self->{nsdname}." : '';
-}
-
-sub rr_rdata {
- my ($self, $packet, $offset) = @_;
- my $rdata = "";
-
- if (exists $self->{"nsdname"}) {
- $rdata .= $packet->dn_comp($self->{"nsdname"}, $offset);
- }
-
- return $rdata;
-}
-
-
-
-sub _canonicalRdata {
- # rdata contains a compressed domainname... we should not have that.
- my ($self) = @_;
- my $rdata;
- $rdata= $self->_name2wire(lc($self->{"nsdname"}));
- return $rdata;
-}
-
-
-1;
-__END__
-
-=head1 NAME
-
-Net::DNS::RR::NS - DNS NS resource record
-
-=head1 SYNOPSIS
-
-C<use Net::DNS::RR>;
-
-=head1 DESCRIPTION
-
-Class for DNS Name Server (NS) resource records.
-
-=head1 METHODS
-
-=head2 nsdname
-
- print "nsdname = ", $rr->nsdname, "\n";
-
-Returns the name of the nameserver.
-
-=head1 COPYRIGHT
-
-Copyright (c) 1997-2002 Michael Fuhr.
-
-Portions Copyright (c) 2002-2004 Chris Reinhardt.
-
-Portions Copyright (c) 2005 O.M, Kolkman, RIPE NCC.
-
-Portions Copyright (c) 2005-2006 O.M, Kolkman, NLnet Labs.
-
-All rights reserved. This program is free software; you may redistribute
-it and/or modify it under the same terms as Perl itself.
-
-=head1 SEE ALSO
-
-L<perl(1)>, L<Net::DNS>, L<Net::DNS::Resolver>, L<Net::DNS::Packet>,
-L<Net::DNS::Header>, L<Net::DNS::Question>, L<Net::DNS::RR>,
-RFC 1035 Section 3.3.11
-
-=cut
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/NSAP.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/NSAP.pm
deleted file mode 100644
index 6b432c90246..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/NSAP.pm
+++ /dev/null
@@ -1,274 +0,0 @@
-package Net::DNS::RR::NSAP;
-#
-# $Id: NSAP.pm 388 2005-06-22 10:06:05Z olaf $
-#
-use strict;
-BEGIN {
- eval { require bytes; }
-}
-use vars qw(@ISA $VERSION);
-
-@ISA = qw(Net::DNS::RR);
-$VERSION = (qw$LastChangedRevision: 388 $)[1];
-
-sub new {
- my ($class, $self, $data, $offset) = @_;
-
- if ($self->{"rdlength"} > 0) {
- my $afi = unpack("\@$offset C", $$data);
- $self->{"afi"} = sprintf("%02x", $afi);
- ++$offset;
-
- if ($self->{"afi"} eq "47") {
- my @idi = unpack("\@$offset C2", $$data);
- $offset += 2;
-
- my $dfi = unpack("\@$offset C", $$data);
- $offset += 1;
-
- my @aa = unpack("\@$offset C3", $$data);
- $offset += 3;
-
- my @rsvd = unpack("\@$offset C2", $$data);
- $offset += 2;
-
- my @rd = unpack("\@$offset C2", $$data);
- $offset += 2;
-
- my @area = unpack("\@$offset C2", $$data);
- $offset += 2;
-
- my @id = unpack("\@$offset C6", $$data);
- $offset += 6;
-
- my $sel = unpack("\@$offset C", $$data);
- $offset += 1;
-
- $self->{"idi"} = sprintf("%02x" x 2, @idi);
- $self->{"dfi"} = sprintf("%02x" x 1, $dfi);
- $self->{"aa"} = sprintf("%02x" x 3, @aa);
- $self->{"rsvd"} = sprintf("%02x" x 2, @rsvd);
- $self->{"rd"} = sprintf("%02x" x 2, @rd);
- $self->{"area"} = sprintf("%02x" x 2, @area);
- $self->{"id"} = sprintf("%02x" x 6, @id);
- $self->{"sel"} = sprintf("%02x" x 1, $sel);
-
- } else {
- # What to do for unsupported versions?
- }
- }
-
- return bless $self, $class;
-}
-
-sub new_from_string {
- my ($class, $self, $string) = @_;
-
- if ($string) {
- $string =~ s/\.//g; # remove all dots.
- $string =~ s/^0x//; # remove leading 0x
-
- if ($string =~ /^[a-zA-Z0-9]{40}$/) {
- @{ $self }{ qw(afi idi dfi aa rsvd rd area id sel) } =
- unpack("A2A4A2A6A4A4A4A12A2", $string);
- }
- }
-
- return bless $self, $class;
-}
-
-
-sub idp {
- my $self = shift;
-
- return join('', $self->{"afi"},
- $self->{"idi"});
-}
-
-sub dsp {
- my $self = shift;
-
- return join('',
- $self->{"dfi"},
- $self->{"aa"},
- $self->rsvd,
- $self->{"rd"},
- $self->{"area"},
- $self->{"id"},
- $self->{"sel"});
-}
-
-sub rsvd {
- my $self = shift;
-
- return exists $self->{"rsvd"} ? $self->{"rsvd"} : "0000";
-}
-
-sub rdatastr {
- my $self = shift;
- my $rdatastr;
-
- if (exists $self->{"afi"}) {
- if ($self->{"afi"} eq "47") {
- $rdatastr = join('', $self->idp, $self->dsp);
- } else {
- $rdatastr = "; AFI $self->{'afi'} not supported";
- }
- } else {
- $rdatastr = '';
- }
-
- return $rdatastr;
-}
-
-sub rr_rdata {
- my $self = shift;
- my $rdata = "";
-
- if (exists $self->{"afi"}) {
- $rdata .= pack("C", hex($self->{"afi"}));
-
- if ($self->{"afi"} eq "47") {
- $rdata .= str2bcd($self->{"idi"}, 2);
- $rdata .= str2bcd($self->{"dfi"}, 1);
- $rdata .= str2bcd($self->{"aa"}, 3);
- $rdata .= str2bcd(0, 2); # rsvd
- $rdata .= str2bcd($self->{"rd"}, 2);
- $rdata .= str2bcd($self->{"area"}, 2);
- $rdata .= str2bcd($self->{"id"}, 6);
- $rdata .= str2bcd($self->{"sel"}, 1);
- }
-
- # Checks for other versions would go here.
- }
-
- return $rdata;
-}
-
-#------------------------------------------------------------------------------
-# Usage: str2bcd(STRING, NUM_BYTES)
-#
-# Takes a string representing a hex number of arbitrary length and
-# returns an equivalent BCD string of NUM_BYTES length (with
-# NUM_BYTES * 2 digits), adding leading zeros if necessary.
-#------------------------------------------------------------------------------
-
-# This can't be the best way....
-sub str2bcd {
- my ($string, $bytes) = @_;
- my $retval = "";
-
- my $digits = $bytes * 2;
- $string = sprintf("%${digits}s", $string);
- $string =~ tr/ /0/;
-
- my $i;
- for ($i = 0; $i < $bytes; ++$i) {
- my $bcd = substr($string, $i*2, 2);
- $retval .= pack("C", hex $bcd);
- }
-
- return $retval;
-}
-
-1;
-__END__
-
-=head1 NAME
-
-Net::DNS::RR::NSAP - DNS NSAP resource record
-
-=head1 SYNOPSIS
-
-C<use Net::DNS::RR>;
-
-=head1 DESCRIPTION
-
-Class for DNS Network Service Access Point (NSAP) resource records.
-
-=head1 METHODS
-
-=head2 idp
-
- print "idp = ", $rr->idp, "\n";
-
-Returns the RR's initial domain part (the AFI and IDI fields).
-
-=head2 dsp
-
- print "dsp = ", $rr->dsp, "\n";
-
-Returns the RR's domain specific part (the DFI, AA, Rsvd, RD, Area,
-ID, and SEL fields).
-
-=head2 afi
-
- print "afi = ", $rr->afi, "\n";
-
-Returns the RR's authority and format identifier. C<Net::DNS>
-currently supports only AFI 47 (GOSIP Version 2).
-
-=head2 idi
-
- print "idi = ", $rr->idi, "\n";
-
-Returns the RR's initial domain identifier.
-
-=head2 dfi
-
- print "dfi = ", $rr->dfi, "\n";
-
-Returns the RR's DSP format identifier.
-
-=head2 aa
-
- print "aa = ", $rr->aa, "\n";
-
-Returns the RR's administrative authority.
-
-=head2 rsvd
-
- print "rsvd = ", $rr->rsvd, "\n";
-
-Returns the RR's reserved field.
-
-=head2 rd
-
- print "rd = ", $rr->rd, "\n";
-
-Returns the RR's routing domain identifier.
-
-=head2 area
-
- print "area = ", $rr->area, "\n";
-
-Returns the RR's area identifier.
-
-=head2 id
-
- print "id = ", $rr->id, "\n";
-
-Returns the RR's system identifier.
-
-=head2 sel
-
- print "sel = ", $rr->sel, "\n";
-
-Returns the RR's NSAP selector.
-
-=head1 COPYRIGHT
-
-Copyright (c) 1997-2002 Michael Fuhr.
-
-Portions Copyright (c) 2002-2004 Chris Reinhardt.
-
-All rights reserved. This program is free software; you may redistribute
-it and/or modify it under the same terms as Perl itself..
-
-=head1 SEE ALSO
-
-L<perl(1)>, L<Net::DNS>, L<Net::DNS::Resolver>, L<Net::DNS::Packet>,
-L<Net::DNS::Header>, L<Net::DNS::Question>, L<Net::DNS::RR>,
-RFC 1706.
-
-=cut
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/NULL.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/NULL.pm
deleted file mode 100644
index db6e58651b0..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/NULL.pm
+++ /dev/null
@@ -1,65 +0,0 @@
-package Net::DNS::RR::NULL;
-#
-# $Id: NULL.pm 388 2005-06-22 10:06:05Z olaf $
-#
-use strict;
-BEGIN {
- eval { require bytes; }
-}
-use vars qw(@ISA $VERSION);
-
-use Net::DNS::Packet;
-
-@ISA = qw(Net::DNS::RR);
-$VERSION = (qw$LastChangedRevision: 388 $)[1];
-
-sub new {
- my ($class, $self, $data, $offset) = @_;
- return bless $self, $class;
-}
-
-1;
-__END__
-
-=head1 NAME
-
-Net::DNS::RR::NULL - DNS NULL resource record
-
-=head1 SYNOPSIS
-
-C<use Net::DNS::RR>;
-
-=head1 DESCRIPTION
-
-Class for DNS Null (NULL) resource records.
-
-=head1 METHODS
-
-=head2 rdlength
-
- print "rdlength = ", $rr->rdlength, "\n";
-
-Returns the length of the record's data section.
-
-=head2 rdata
-
- $rdata = $rr->rdata;
-
-Returns the record's data section as binary data.
-
-=head1 COPYRIGHT
-
-Copyright (c) 1997-2002 Michael Fuhr.
-
-Portions Copyright (c) 2002-2004 Chris Reinhardt.
-
-All rights reserved. This program is free software; you may redistribute
-it and/or modify it under the same terms as Perl itself.
-
-=head1 SEE ALSO
-
-L<perl(1)>, L<Net::DNS>, L<Net::DNS::Resolver>, L<Net::DNS::Packet>,
-L<Net::DNS::Header>, L<Net::DNS::Question>, L<Net::DNS::RR>,
-RFC 1035 Section 3.3.10
-
-=cut
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/OPT.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/OPT.pm
deleted file mode 100644
index 67c9e1ba0af..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/OPT.pm
+++ /dev/null
@@ -1,286 +0,0 @@
-package Net::DNS::RR::OPT;
-#
-# $Id: OPT.pm 393 2005-07-01 19:21:52Z olaf $
-#
-
-use strict;
-BEGIN {
- eval { require bytes; }
-}
-use vars qw(@ISA $VERSION %extendedrcodesbyname %extendedrcodesbyval $EDNSVERSION);
-
-use Carp;
-
-@ISA = qw(Net::DNS::RR);
-$VERSION = (qw$LastChangedRevision: 393 $)[1];
-
-$EDNSVERSION = 0;
-
-%extendedrcodesbyname = (
- "ONLY_RDATA" => 0, # No name specified see 4.6 of 2671
- "UNDEF1" => 1,
- "UNDEF2" => 2,
- "UNDEF3" => 3,
- "UNDEF4" => 4,
- "UNDEF5" => 5,
- "UNDEF6" => 6,
- "UNDEF7" => 7,
- "UNDEF8" => 8,
- "UNDEF9" => 9,
- "UNDEF10" => 10,
- "UNDEF11" => 11,
- "UNDEF12" => 12,
- "UNDEF13" => 13,
- "UNDEF14" => 14,
- "UNDEF15" => 15,
- "BADVERS" => 16, # RFC 2671
-);
-%extendedrcodesbyval = reverse %extendedrcodesbyname;
-
-
-
-sub new {
- my ($class, $self, $data, $offset) = @_;
-
- $self->{"name"} = "" ; # should allway be "root"
-
- if ($self->{"rdlength"} > 0) {
- $self->{"optioncode"} = unpack("n", substr($$data, $offset, 2));
- $self->{"optionlength"} = unpack("n", substr($$data, $offset+2, 2));
- $self->{"optiondata"} = unpack("n", substr($$data, $offset+4, $self->{"optionlength"}));
- }
-
- $self->{"_rcode_flags"} = pack("N",$self->{"ttl"});
-
- $self->{"extendedrcode"} = unpack("C", substr($self->{"_rcode_flags"}, 0, 1));
- $self->{"ednsversion"} = unpack("C", substr($self->{"_rcode_flags"}, 1, 1));
- $self->{"ednsflags"} = unpack("n", substr($self->{"_rcode_flags"}, 2, 2));
-
-
- return bless $self, $class;
-}
-
-
-
-
-
-
-sub new_from_string {
- my ($class, $self ) = @_;
-
- # There is no such thing as an OPT RR in a ZONE file.
- # Not implemented!
- croak "You should not try to create a OPT RR from a string\nNot implemented";
- return bless $self, $class;
-}
-
-
-
-sub new_from_hash {
- my ($class, $self ) = @_;
-
- $self->{"name"} = "" ; # should allway be "root"
- # Setting the MTU smaller then 512 does not make sense
- # should we test for a maximum here?
- if ($self->{"class"} eq "IN" || $self->{"class"} < 512) {
- $self->{"class"} = 512; # Default value...
- }
-
- $self->{"extendedrcode"} = 0 unless exists $self->{"extendedrcode"};
-
- $self->{"ednsflags"} = 0 unless exists $self->{"ednsflags"};
- $self->{"ednsversion"} = $EDNSVERSION unless exists $self->{"ednsversion"};
- $self->{"ttl"}= unpack ("N",
- pack("C", $self->{"extendedrcode"}) .
- pack("C", $self->{"ednsversion"}) .
- pack("n", $self->{"ednsflags"})
- );
-
- if (exists $self->{"optioncode"}) {
- $self->{"optiondata"} = "" if ! exists $self->{"optiondata"};
- $self->{"optionlength"} = length $self->{"optiondata"}
- }
-
- return bless $self, $class;
-
-}
-
-
-
-
-
-sub string {
- my $self = shift;
- return
- "; EDNS Version " . $self->{"ednsversion"} .
- "\t UDP Packetsize: " . $self->{"class"} .
- "\n; EDNS-RCODE:\t" . $self->{"extendedrcode"} .
- " (" . $extendedrcodesbyval{ $self->{"extendedrcode"} }. ")" .
- "\n; EDNS-FLAGS:\t" . sprintf("0x%04x", $self->{"ednsflags"}) .
- "\n";
-}
-
-
-sub rdatastr {
- return '; Parsing of OPT rdata is not yet implemented';
-}
-
-
-sub rr_rdata {
- my $self = shift;
- my $rdata;
-
- if (exists $self->{"optioncode"}) {
- $rdata = pack("n", $self->{"optioncode"});
- $rdata .= pack("n", $self->{"optionlength"});
- $rdata .= $self->{"optiondata"}
- } else {
- $rdata = "";
- }
-
- return $rdata;
-}
-
-
-
-
-
-
-
-sub do{
- my $self=shift;
- return ( 0x8000 & $self->{"ednsflags"} );
-}
-
-
-
-sub set_do{
- my $self=shift;
- return $self->{"ednsflags"} = ( 0x8000 | $self->{"ednsflags"} );
-
-}
-
-
-
-sub clear_do{
- my $self=shift;
- return $self->{"ednsflags"} = ( ~0x8000 & $self->{"ednsflags"} );
-
-}
-
-
-
-sub size {
- my $self=shift;
- my $size=shift;
- $self->{"class"}=$size if defined($size);
- return $self->{"class"};
-}
-
-
-
-
-1;
-__END__
-
-=head1 NAME
-
-Net::DNS::RR::OPT - DNS OPT
-
-=head1 SYNOPSIS
-
-C<use Net::DNS::RR>;
-
-=head1 DESCRIPTION
-
-Class for EDNS pseudo resource record OPT.
-
-=head1 METHODS
-
-This object should only be used inside the Net::DNS classes itself.
-
-=head2 new
-
-Since "OPT" is a pseudo record and should not be stored in
-masterfiles; Therefore we have not implemented a method to create this
-RR from string.
-
-One may create the object from a hash. See RFC 2671 for details for
-the meaning of the hash keys.
-
- $rr= new Net::DNS::RR {
- name => "", # Ignored and set to ""
- type => "OPT",
- class => 1024, # sets UDP payload size
- extendedrcode => 0x00, # sets the extended RCODE 1 octets
- ednsflags => 0x0000, # sets the ednsflags (2octets)
- optioncode => 0x0 # 2 octets
- optiondata => 0x0 # optionlength octets
- }
-
-The ednsversion is set to 0 for now. The ttl value is determined from
-the extendedrcode, the ednsversion and the ednsflag.
-The rdata is constructed from the optioncode and optiondata
-see section 4.4 of RFC 2671
-
-If optioncode is left undefined then we do not expect any RDATA.
-
-The defaults are no rdata.
-
-
-=head2 do, set_do, clear_do
-
- $opt->set_do;
-
-Reads, sets and clears the do flag. (first bit in the ednssflags);
-
-
-=head2 size
-
- $opt->size(1498);
- print "Packet size:". $opt->size() ;
-
-Sets or gets the packet size.
-
-
-=head1 TODO
-
-- This class is tailored to use with dnssec.
-
-- Do some range checking on the input.
-
-- This class probably needs subclasses once OPTION codes start to be defined.
-
-- look at use of extended labels
-
-=head1 COPYRIGHT
-
-Copyright (c) 2001, 2002 RIPE NCC. Author Olaf M. Kolkman
-
-All Rights Reserved
-
-Permission to use, copy, modify, and distribute this software and its
-documentation for any purpose and without fee is hereby granted,
-provided that the above copyright notice appear in all copies and that
-both that copyright notice and this permission notice appear in
-supporting documentation, and that the name of the author not be
-used in advertising or publicity pertaining to distribution of the
-software without specific, written prior permission.
-
-
-THE AUTHOR DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING
-ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS; IN NO EVENT SHALL
-AUTHOR BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY
-DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN
-AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
-OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
-
-Based on, and contains, code by Copyright (c) 1997-2002 Michael Fuhr.
-
-=head1 SEE ALSO
-
-L<perl(1)>, L<Net::DNS>, L<Net::DNS::Resolver>, L<Net::DNS::Packet>,
-L<Net::DNS::Header>, L<Net::DNS::Question>, L<Net::DNS::RR>,
-RFC 2435 Section 3
-
-=cut
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/PTR.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/PTR.pm
deleted file mode 100644
index bf894f26c07..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/PTR.pm
+++ /dev/null
@@ -1,101 +0,0 @@
-package Net::DNS::RR::PTR;
-#
-# $Id: PTR.pm 632 2007-03-12 13:24:21Z olaf $
-#
-use strict;
-BEGIN {
- eval { require bytes; }
-}
-use vars qw(@ISA $VERSION);
-
-@ISA = qw(Net::DNS::RR);
-$VERSION = (qw$LastChangedRevision: 632 $)[1];
-
-sub new {
- my ($class, $self, $data, $offset) = @_;
-
- if ($self->{"rdlength"} > 0) {
- ($self->{"ptrdname"}) = Net::DNS::Packet::dn_expand($data, $offset);
- }
-
- return bless $self, $class;
-}
-
-sub new_from_string {
- my ($class, $self, $string) = @_;
-
- if ($string) {
- $string =~ s/\.+$//;
- $self->{"ptrdname"} = $string;
- }
-
- return bless $self, $class;
-}
-
-sub rdatastr {
- my $self = shift;
-
- return $self->{"ptrdname"} ? "$self->{ptrdname}." : '';
-}
-
-sub rr_rdata {
- my ($self, $packet, $offset) = @_;
- my $rdata = "";
-
- if (exists $self->{"ptrdname"}) {
- $rdata .= $packet->dn_comp(lc($self->{"ptrdname"}), $offset);
- }
-
- return $rdata;
-}
-
-sub _canonicalRdata {
- my ($self, $packet, $offset) = @_;
- my $rdata = "";
-
- if (exists $self->{"ptrdname"}) {
- $rdata .= $self->_name2wire($self->{"ptrdname"});
- }
-
- return $rdata;
-}
-
-1;
-__END__
-
-=head1 NAME
-
-Net::DNS::RR::PTR - DNS PTR resource record
-
-=head1 SYNOPSIS
-
-C<use Net::DNS::RR>;
-
-=head1 DESCRIPTION
-
-Class for DNS Pointer (PTR) resource records.
-
-=head1 METHODS
-
-=head2 ptrdname
-
- print "ptrdname = ", $rr->ptrdname, "\n";
-
-Returns the domain name associated with this record.
-
-=head1 COPYRIGHT
-
-Copyright (c) 1997-2002 Michael Fuhr.
-
-Portions Copyright (c) 2002-2004 Chris Reinhardt.
-
-All rights reserved. This program is free software; you may redistribute
-it and/or modify it under the same terms as Perl itself.
-
-=head1 SEE ALSO
-
-L<perl(1)>, L<Net::DNS>, L<Net::DNS::Resolver>, L<Net::DNS::Packet>,
-L<Net::DNS::Header>, L<Net::DNS::Question>, L<Net::DNS::RR>,
-RFC 1035 Section 3.3.12
-
-=cut
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/PX.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/PX.pm
deleted file mode 100644
index a9b4a3206e6..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/PX.pm
+++ /dev/null
@@ -1,153 +0,0 @@
-package Net::DNS::RR::PX;
-#
-# $Id: PX.pm 632 2007-03-12 13:24:21Z olaf $
-#
-use strict;
-BEGIN {
- eval { require bytes; }
-}
-use vars qw(@ISA $VERSION);
-
-@ISA = qw(Net::DNS::RR);
-$VERSION = (qw$LastChangedRevision: 632 $)[1];
-
-
-
-# Highest preference sorted first.
-
-__PACKAGE__->set_rrsort_func("preference",
- sub {
- my ($a,$b)=($Net::DNS::a,$Net::DNS::b);
- $a->{'preference'} <=> $b->{'preference'}
-}
-);
-
-
-__PACKAGE__->set_rrsort_func("default_sort",
- __PACKAGE__->get_rrsort_func("preference")
-
- );
-
-
-
-
-sub new {
- my ($class, $self, $data, $offset) = @_;
-
- if ($self->{"rdlength"} > 0) {
- ($self->{"preference"}) = unpack("\@$offset n", $$data);
- $offset += Net::DNS::INT16SZ();
-
- ($self->{"map822"}, $offset) = Net::DNS::Packet::dn_expand($data, $offset);
- ($self->{"mapx400"}, $offset) = Net::DNS::Packet::dn_expand($data, $offset);
- }
-
- return bless $self, $class;
-}
-
-sub new_from_string {
- my ($class, $self, $string) = @_;
-
- if ($string && ($string =~ /^(\d+)\s+(\S+)\s+(\S+)$/)) {
- $self->{"preference"} = $1;
- $self->{"map822"} = $2;
- $self->{"mapx400"} = $3;
- $self->{"map822"} =~ s/\.+$//;;
- $self->{"mapx400"} =~ s/\.+$//;;
- }
-
- return bless $self, $class;
-}
-
-sub rdatastr {
- my $self = shift;
-
- return $self->{"preference"}
- ? "$self->{preference} $self->{map822}. $self->{mapx400}."
- : '';
-}
-
-sub rr_rdata {
- my ($self, $packet, $offset) = @_;
- my $rdata = "";
-
- if (exists $self->{"preference"}) {
- $rdata .= pack("n", $self->{"preference"});
-
- $rdata .= $packet->dn_comp($self->{"map822"},
- $offset + length $rdata);
-
- $rdata .= $packet->dn_comp($self->{"mapx400"},
- $offset + length $rdata);
- }
-
- return $rdata;
-}
-
-
-sub _canonicalRdata {
- my ($self) = shift;
- my $rdata = "";
-
- if (exists $self->{"preference"}) {
- $rdata .= pack("n", $self->{"preference"});
- $rdata .= $self->_name2wire(lc($self->{"map822"}));
- $rdata .= $self->_name2wire(lc($self->{"mapx400"}));
- }
-
- return $rdata;
-}
-
-
-1;
-__END__
-
-=head1 NAME
-
-Net::DNS::RR::PX - DNS PX resource record
-
-=head1 SYNOPSIS
-
-C<use Net::DNS::RR>;
-
-=head1 DESCRIPTION
-
-Class for DNS X.400 Mail Mapping Information (PX) resource records.
-
-=head1 METHODS
-
-=head2 preference
-
- print "preference = ", $rr->preference, "\n";
-
-Returns the preference given to this RR.
-
-=head2 map822
-
- print "map822 = ", $rr->map822, "\n";
-
-Returns the RFC822 part of the RFC1327 mapping information.
-
-=head2 mapx400
-
- print "mapx400 = ", $rr->mapx400, "\n";
-
-Returns the X.400 part of the RFC1327 mapping information.
-
-=head1 COPYRIGHT
-
-Copyright (c) 1997-2002 Michael Fuhr.
-
-Portions Copyright (c) 2002-2004 Chris Reinhardt.
-Portions Copyright (c) 2005 Olaf Kolkman NLnet Labs.
-
-All rights reserved. This program is free software; you may redistribute
-it and/or modify it under the same terms as Perl itself.
-
-=head1 SEE ALSO
-
-L<perl(1)>, L<Net::DNS>, L<Net::DNS::Resolver>, L<Net::DNS::Packet>,
-L<Net::DNS::Header>, L<Net::DNS::Question>, L<Net::DNS::RR>,
-RFC822, RFC 1327, RFC 2163
-
-=cut
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/RP.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/RP.pm
deleted file mode 100644
index 7c422c3a17c..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/RP.pm
+++ /dev/null
@@ -1,121 +0,0 @@
-package Net::DNS::RR::RP;
-#
-# $Id: RP.pm 702 2008-01-21 10:01:21Z olaf $
-#
-use strict;
-BEGIN {
- eval { require bytes; }
-}
-use vars qw(@ISA $VERSION);
-
-@ISA = qw(Net::DNS::RR);
-$VERSION = (qw$LastChangedRevision: 702 $)[1];
-
-sub new {
- my ($class, $self, $data, $offset) = @_;
-
- if ($self->{"rdlength"} > 0) {
- ($self->{"mbox"}, $offset) = Net::DNS::Packet::dn_expand($data, $offset);
- ($self->{"txtdname"}, $offset) = Net::DNS::Packet::dn_expand($data, $offset);
- }
-
- return bless $self, $class;
-}
-
-sub new_from_string {
- my ($class, $self, $string) = @_;
-
- if ($string && ($string =~ /^(\S+)\s+(\S+)$/)) {
- $self->{"mbox"} = $1;
- $self->{"txtdname"} = $2;
- $self->{"mbox"} =~ s/\.+$//;
- $self->{"txtdname"} =~ s/\.+$//;
- }
-
- return bless $self, $class;
-}
-
-sub rdatastr {
- my $self = shift;
- if (exists $self->{"mbox"}) {
- return "$self->{mbox}. $self->{txtdname}.";
- }
- return '';
-
-}
-
-sub rr_rdata {
- my ($self, $packet, $offset) = @_;
- my $rdata = "";
-
- if (exists $self->{"mbox"}) {
- $rdata .= $packet->dn_comp($self->{"mbox"}, $offset);
- $rdata .= $packet->dn_comp($self->{"txtdname"},
- $offset + length $rdata);
- }
-
- return $rdata;
-}
-
-
-sub _canonicalRdata {
- my $self = shift;
- my $rdata = "";
- if (exists $self->{"mbox"}) {
- $rdata .= $self->_name2wire(lc($self->{"mbox"}));
- $rdata .= $self->_name2wire(lc($self->{"txtdname"}));
-
-
- }
-
- return $rdata;
-}
-
-
-
-1;
-__END__
-
-=head1 NAME
-
-Net::DNS::RR::RP - DNS RP resource record
-
-=head1 SYNOPSIS
-
-C<use Net::DNS::RR>;
-
-=head1 DESCRIPTION
-
-Class for DNS Responsible Person (RP) resource records.
-
-=head1 METHODS
-
-=head2 mbox
-
- print "mbox = ", $rr->mbox, "\n";
-
-Returns a domain name that specifies the mailbox for the responsible person.
-
-=head2 txtdname
-
- print "txtdname = ", $rr->txtdname, "\n";
-
-Returns a domain name that specifies a TXT record containing further
-information about the responsible person.
-
-=head1 COPYRIGHT
-
-Copyright (c) 1997-2002 Michael Fuhr.
-
-Portions Copyright (c) 2002-2004 Chris Reinhardt.
-
-All rights reserved. This program is free software; you may redistribute
-it and/or modify it under the same terms as Perl itself.
-
-=head1 SEE ALSO
-
-L<perl(1)>, L<Net::DNS>, L<Net::DNS::Resolver>, L<Net::DNS::Packet>,
-L<Net::DNS::Header>, L<Net::DNS::Question>, L<Net::DNS::RR>,
-RFC 1183 Section 2.2
-
-=cut
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/RT.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/RT.pm
deleted file mode 100644
index 22f0891d944..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/RT.pm
+++ /dev/null
@@ -1,133 +0,0 @@
-package Net::DNS::RR::RT;
-#
-# $Id: RT.pm 632 2007-03-12 13:24:21Z olaf $
-#
-use strict;
-BEGIN {
- eval { require bytes; }
-}
-use vars qw(@ISA $VERSION);
-
-@ISA = qw(Net::DNS::RR);
-$VERSION = (qw$LastChangedRevision: 632 $)[1];
-
-# Highest preference sorted first.
-__PACKAGE__->set_rrsort_func("preference",
- sub {
- my ($a,$b)=($Net::DNS::a,$Net::DNS::b);
- $a->{'preference'} <=> $b->{'preference'}
-}
-);
-
-
-__PACKAGE__->set_rrsort_func("default_sort",
- __PACKAGE__->get_rrsort_func("preference")
-
- );
-
-
-sub new {
- my ($class, $self, $data, $offset) = @_;
-
- if ($self->{"rdlength"} > 0) {
- ($self->{"preference"}) = unpack("\@$offset n", $$data);
- $offset += Net::DNS::INT16SZ();
-
- ($self->{"intermediate"}) = Net::DNS::Packet::dn_expand($data, $offset);
- }
-
- return bless $self, $class;
-}
-
-sub new_from_string {
- my ($class, $self, $string) = @_;
-
- if ($string && ($string =~ /^(\d+)\s+(\S+)$/)) {
- $self->{"preference"} = $1;
- $self->{"intermediate"} = $2;
- $self->{"intermediate"} =~ s/\.+$//;
- }
-
- return bless $self, $class;
-}
-
-sub rdatastr {
- my $self = shift;
-
- return $self->{"preference"}
- ? "$self->{preference} $self->{intermediate}."
- : '';
-}
-
-sub rr_rdata {
- my ($self, $packet, $offset) = @_;
- my $rdata = "";
-
- if (exists $self->{"preference"}) {
- $rdata .= pack("n", $self->{"preference"});
- $rdata .= $packet->dn_comp($self->{"intermediate"},
- $offset + length $rdata);
- }
-
- return $rdata;
-}
-
-sub _canonicalRdata {
- my ($self, $packet, $offset) = @_;
- my $rdata = "";
-
- if (exists $self->{"preference"}) {
- $rdata .= pack("n", $self->{"preference"});
- $rdata .= $self->_name2wire(lc($self->{"intermediate"}));
- }
-
- return $rdata;
-}
-
-
-1;
-__END__
-
-=head1 NAME
-
-Net::DNS::RR::RT - DNS RT resource record
-
-=head1 SYNOPSIS
-
-C<use Net::DNS::RR>;
-
-=head1 DESCRIPTION
-
-Class for DNS Route Through (RT) resource records.
-
-=head1 METHODS
-
-=head2 preference
-
- print "preference = ", $rr->preference, "\n";
-
-Returns the preference for this route.
-
-=head2 intermediate
-
- print "intermediate = ", $rr->intermediate, "\n";
-
-Returns the domain name of the intermediate host.
-
-=head1 COPYRIGHT
-
-Copyright (c) 1997-2002 Michael Fuhr.
-
-Portions Copyright (c) 2002-2004 Chris Reinhardt.
-Portions Copyright (c) 2005 Olaf Kolkman NLnet Labs.
-
-All rights reserved. This program is free software; you may redistribute
-it and/or modify it under the same terms as Perl itself.
-
-=head1 SEE ALSO
-
-L<perl(1)>, L<Net::DNS>, L<Net::DNS::Resolver>, L<Net::DNS::Packet>,
-L<Net::DNS::Header>, L<Net::DNS::Question>, L<Net::DNS::RR>,
-RFC 1183 Section 3.3
-
-=cut
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/SOA.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/SOA.pm
deleted file mode 100644
index 9cf24d4def1..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/SOA.pm
+++ /dev/null
@@ -1,176 +0,0 @@
-package Net::DNS::RR::SOA;
-#
-# $Id: SOA.pm 632 2007-03-12 13:24:21Z olaf $
-#
-use strict;
-BEGIN {
- eval { require bytes; }
-}
-use vars qw(@ISA $VERSION);
-
-@ISA = qw(Net::DNS::RR);
-$VERSION = (qw$LastChangedRevision: 632 $)[1];
-
-sub new {
- my ($class, $self, $data, $offset) = @_;
-
- if ($self->{"rdlength"} > 0) {
- ($self->{"mname"}, $offset) = Net::DNS::Packet::dn_expand($data, $offset);
- ($self->{"rname"}, $offset) = Net::DNS::Packet::dn_expand($data, $offset);
-
- @{$self}{qw(serial refresh retry expire minimum)} = unpack("\@$offset N5", $$data);
- }
-
- return bless $self, $class;
-}
-
-sub new_from_string {
- my ($class, $self, $string) = @_;
-
- if ($string) {
- $string =~ tr/()//d;
-
- # XXX do we need to strip out comments here now that RR.pm does it?
- $string =~ s/;.*$//mg;
-
- @{$self}{qw(mname rname serial refresh retry expire minimum)} = $string =~ /(\S+)/g;
-
- $self->{'mname'} =~ s/\.+$//;
- $self->{'rname'} =~ s/\.+$//;
- }
-
- return bless $self, $class;
-}
-
-sub rdatastr {
- my $self = shift;
- my $rdatastr;
-
- if (exists $self->{"mname"}) {
- $rdatastr = "$self->{mname}. $self->{rname}. (\n";
- $rdatastr .= "\t" x 5 . "$self->{serial}\t; Serial\n";
- $rdatastr .= "\t" x 5 . "$self->{refresh}\t; Refresh\n";
- $rdatastr .= "\t" x 5 . "$self->{retry}\t; Retry\n";
- $rdatastr .= "\t" x 5 . "$self->{expire}\t; Expire\n";
- $rdatastr .= "\t" x 5 . "$self->{minimum} )\t; Minimum TTL";
- } else {
- $rdatastr = '';
- }
-
- return $rdatastr;
-}
-
-sub rr_rdata {
- my ($self, $packet, $offset) = @_;
- my $rdata = "";
-
- # Assume that if one field exists, they all exist. Script will
- # print a warning otherwise.
-
- if (exists $self->{"mname"}) {
- $rdata .= $packet->dn_comp($self->{"mname"}, $offset);
- $rdata .= $packet->dn_comp($self->{"rname"}, $offset + length $rdata);
-
- $rdata .= pack("N5", @{$self}{qw(serial refresh retry expire minimum)});
- }
-
- return $rdata;
-}
-
-
-
-sub _canonicalRdata {
- my $self=shift;
- my $rdata = "";
-
- # Assume that if one field exists, they all exist. Script will
- # print a warning otherwise.
-
- if (exists $self->{"mname"}) {
- $rdata .= $self->_name2wire(lc($self->{"mname"}));
- $rdata .= $self->_name2wire(lc($self->{"rname"}));
- $rdata .= pack("N5", @{$self}{qw(serial refresh retry expire minimum)});
- }
-
- return $rdata;
-}
-
-
-
-1;
-__END__
-
-=head1 NAME
-
-Net::DNS::RR::SOA - DNS SOA resource record
-
-=head1 SYNOPSIS
-
-C<use Net::DNS::RR>;
-
-=head1 DESCRIPTION
-
-Class for DNS Start of Authority (SOA) resource records.
-
-=head1 METHODS
-
-=head2 mname
-
- print "mname = ", $rr->mname, "\n";
-
-Returns the domain name of the original or primary nameserver for
-this zone.
-
-=head2 rname
-
- print "rname = ", $rr->rname, "\n";
-
-Returns a domain name that specifies the mailbox for the person
-responsible for this zone.
-
-=head2 serial
-
- print "serial = ", $rr->serial, "\n";
-
-Returns the zone's serial number.
-
-=head2 refresh
-
- print "refresh = ", $rr->refresh, "\n";
-
-Returns the zone's refresh interval.
-
-=head2 retry
-
- print "retry = ", $rr->retry, "\n";
-
-Returns the zone's retry interval.
-
-=head2 expire
-
- print "expire = ", $rr->expire, "\n";
-
-Returns the zone's expire interval.
-
-=head2 minimum
-
- print "minimum = ", $rr->minimum, "\n";
-
-Returns the minimum (default) TTL for records in this zone.
-
-=head1 COPYRIGHT
-
-Copyright (c) 1997-2002 Michael Fuhr.
-
-Portions Copyright (c) 2002-2004 Chris Reinhardt.
-
-All rights reserved. This program is free software; you may redistribute
-it and/or modify it under the same terms as Perl itself.
-
-=head1 SEE ALSO
-
-L<perl(1)>, L<Net::DNS>, L<Net::DNS::Resolver>, L<Net::DNS::Packet>,
-L<Net::DNS::Header>, L<Net::DNS::Question>, L<Net::DNS::RR>,
-RFC 1035 Section 3.3.13
-
-=cut
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/SPF.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/SPF.pm
deleted file mode 100644
index d8cd48c8e51..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/SPF.pm
+++ /dev/null
@@ -1,48 +0,0 @@
-package Net::DNS::RR::SPF;
-#
-# $Id: SPF.pm 684 2007-10-10 12:32:22Z olaf $
-#
-use strict;
-BEGIN {
- eval { require bytes; }
-}
-use vars qw(@ISA $VERSION);
-use Net::DNS::RR::TXT;
-
-
-@ISA = qw(Net::DNS::RR::TXT);
-$VERSION = (qw$LastChangedRevision: 684 $)[1];
-
-1;
-
-=head1 NAME
-
-Net::DNS::RR::SPF - DNS SPF resource record
-
-=head1 SYNOPSIS
-
-C<use Net::DNS::RR>;
-
-=head1 DESCRIPTION
-
-This is a clone of the TXT record. This class therfore completely inherits
-all properties of the Net::DNS::RR::TXT class.
-
-Please see the L<Net::DNS::RR::TXT> perldocumentation for details
-
-=head1 COPYRIGHT
-
-Copyright (c) 2005 Olaf Kolkman (NLnet Labs)
-
-All rights reserved. This program is free software; you may redistribute
-it and/or modify it under the same terms as Perl itself.
-
-=head1 SEE ALSO
-
-L<perl(1)>, L<Net::DNS>, L<Net::DNS::Resolver>, L<Net::DNS::Packet>,
-L<Net::DNS::Header>, L<Net::DNS::Question>, L<Net::DNS::RR>,
-RFC 1035 Section 3.3.14, RFC 4408
-
-
-=cut
-
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/SRV.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/SRV.pm
deleted file mode 100644
index a80ded72ba5..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/SRV.pm
+++ /dev/null
@@ -1,151 +0,0 @@
-package Net::DNS::RR::SRV;
-#
-# $Id: SRV.pm 583 2006-05-03 12:24:18Z olaf $
-#
-use strict;
-BEGIN {
- eval { require bytes; }
-}
-use vars qw(@ISA $VERSION);
-
-@ISA = qw(Net::DNS::RR);
-$VERSION = (qw$LastChangedRevision: 583 $)[1];
-
-
-
-__PACKAGE__->set_rrsort_func("priority",
- sub {
- my ($a,$b)=($Net::DNS::a,$Net::DNS::b);
- $a->{'priority'} <=> $b->{'priority'}
- ||
- $b->{'weight'} <=> $a->{'weight'}
-}
-);
-
-
-__PACKAGE__->set_rrsort_func("default_sort",
- __PACKAGE__->get_rrsort_func("priority")
-
- );
-
-__PACKAGE__->set_rrsort_func("weight",
- sub {
- my ($a,$b)=($Net::DNS::a,$Net::DNS::b);
- $b->{"weight"} <=> $a->{"weight"}
- ||
- $a->{"priority"} <=> $b->{"priority"}
-}
-);
-
-
-
-sub new {
- my ($class, $self, $data, $offset) = @_;
-
- if ($self->{'rdlength'} > 0) {
- @{$self}{qw(priority weight port)} = unpack("\@$offset n3", $$data);
- $offset += 3 * Net::DNS::INT16SZ();
-
- ($self->{'target'}) = Net::DNS::Packet::dn_expand($data, $offset);
- }
-
- return bless $self, $class;
-}
-
-sub new_from_string {
- my ($class, $self, $string) = @_;
-
- if ($string && ($string =~ /^(\d+)\s+(\d+)\s+(\d+)\s+(\S+)$/)) {
- @{$self}{qw(priority weight port target)} = ($1, $2, $3, $4);
-
- $self->{'target'} =~ s/\.+$//;
- }
-
- return bless $self, $class;
-}
-
-sub rdatastr {
- my $self = shift;
- my $rdatastr;
-
- if (exists $self->{'priority'}) {
- $rdatastr = join(' ', @{$self}{qw(priority weight port target)});
- $rdatastr =~ s/(.*[^\.])$/$1./;
- } else {
- $rdatastr = '';
- }
-
- return $rdatastr;
-}
-
-sub rr_rdata {
- my ($self, $packet, $offset) = @_;
- my $rdata = '';
-
- if (exists $self->{'priority'}) {
- $rdata .= pack('n3', @{$self}{qw(priority weight port)});
- $rdata .= $self->_name2wire ($self->{"target"});
-
- }
-
- return $rdata;
-}
-
-
-1;
-__END__
-
-=head1 NAME
-
-Net::DNS::RR::SRV - DNS SRV resource record
-
-=head1 SYNOPSIS
-
-C<use Net::DNS::RR>;
-
-=head1 DESCRIPTION
-
-Class for DNS Service (SRV) resource records.
-
-=head1 METHODS
-
-=head2 priority
-
- print "priority = ", $rr->priority, "\n";
-
-Returns the priority for this target host.
-
-=head2 weight
-
- print "weight = ", $rr->weight, "\n";
-
-Returns the weight for this target host.
-
-=head2 port
-
- print "port = ", $rr->port, "\n";
-
-Returns the port on this target host for the service.
-
-=head2 target
-
- print "target = ", $rr->target, "\n";
-
-Returns the target host.
-
-=head1 COPYRIGHT
-
-Copyright (c) 1997-2002 Michael Fuhr.
-
-Portions Copyright (c) 2002-2004 Chris Reinhardt.
-
-All rights reserved. This program is free software; you may redistribute
-it and/or modify it under the same terms as Perl itself.
-
-=head1 SEE ALSO
-
-L<perl(1)>, L<Net::DNS>, L<Net::DNS::Resolver>, L<Net::DNS::Packet>,
-L<Net::DNS::Header>, L<Net::DNS::Question>, L<Net::DNS::RR>,
-RFC 2782
-
-=cut
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/SSHFP.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/SSHFP.pm
deleted file mode 100644
index 4890c3766e3..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/SSHFP.pm
+++ /dev/null
@@ -1,219 +0,0 @@
-package Net::DNS::RR::SSHFP;
-#
-# $Id: SSHFP.pm 626 2007-02-02 07:31:32Z olaf $
-#
-use strict;
-BEGIN {
- eval { require bytes; }
-}
-use vars qw(@ISA $VERSION $HasBabble);
-
-BEGIN {
- eval {
- require Digest::BubbleBabble;
- Digest::BubbleBabble->import(qw(bubblebabble))
- };
-
- $HasBabble = $@ ? 0 : 1;
-
-}
-
-$VERSION = (qw$LastChangedRevision: 626 $)[1];
-
-@ISA = qw(Net::DNS::RR);
-
-my %algtype = (
- RSA => 1,
- DSA => 2,
-);
-
-my %fingerprinttype = (
- 'SHA-1' => 1,
-);
-
-my %fingerprinttypebyval = reverse %fingerprinttype;
-my %algtypebyval = reverse %algtype;
-
-
-sub new {
- my ($class, $self, $data, $offset) = @_;
-
- if ($self->{'rdlength'} > 0) {
- my $offsettoalg = $offset;
- my $offsettofptype = $offset+1;
- my $offsettofp = $offset+2;
- my $fplength = 20; # This will need to change if other fingerprint types
- # are being deployed.
-
-
- $self->{'algorithm'} = unpack('C', substr($$data, $offsettoalg, 1));
- $self->{'fptype'} = unpack('C', substr($$data, $offsettofptype, 1));
-
- unless (defined $fingerprinttypebyval{$self->{'fptype'}}){
- warn "This fingerprint type $self->{'fptype'} has not yet been implemented, creation of SSHFP failed\n." ;
- return undef;
- }
-
-
- # All this is SHA-1 dependend
- $self->{'fpbin'} = substr($$data,$offsettofp, $fplength); # SHA1 digest 20 bytes long
-
- $self->{'fingerprint'} = uc unpack('H*', $self->{'fpbin'});
- }
-
-
- return bless $self, $class;
-}
-
-
-sub new_from_string {
- my ($class, $self, $string) = @_;
-
- if ($string) {
- $string =~ tr/()//d;
- $string =~ s/;.*$//mg;
- $string =~ s/\n//g;
-
- @{$self}{qw(algorithm fptype fingerprint)} = split(m/\s+/, $string, 3);
-
- # We allow spaces in the fingerprint.
- $self->{'fingerprint'} =~ s/\s//g;
- }
-
- return bless $self, $class;
-}
-
-
-
-sub rdatastr {
- my $self = shift;
- my $rdatastr = '';
-
- if (exists $self->{"algorithm"}) {
- $rdatastr = join(' ', @{$self}{qw(algorithm fptype fingerprint)})
- .' ; ' . $self->babble;
- }
-
- return $rdatastr;
-}
-
-sub rr_rdata {
- my $self = shift;
-
- if (exists $self->{"algorithm"}) {
- return pack('C2', @{$self}{qw(algorithm fptype)}) . $self->fpbin;
- }
-
- return '';
-
-}
-
-
-
-sub babble {
- my $self = shift;
-
- if ($HasBabble) {
- return bubblebabble(Digest => $self->fpbin);
- } else {
- return "";
- }
-}
-
-
-sub fpbin {
- my ($self) = @_;
-
- return $self->{'fpbin'} ||= pack('H*', $self->{'fingerprint'});
-}
-
-
-1;
-
-
-=head1 NAME
-
-Net::DNS::RR::SSHFP - DNS SSHFP resource record
-
-=head1 SYNOPSIS
-
-C<use Net::DNS::RR>;
-
-=head1 DESCRIPTION
-
-Class for Delegation signer (SSHFP) resource records.
-
-=head1 METHODS
-
-In addition to the regular methods
-
-
-=head2 algorithm
-
- print "algoritm" = ", $rr->algorithm, "\n";
-
-Returns the RR's algorithm field in decimal representation
-
- 1 = RSA
- 2 = DSS
-
-
-=head2 fingerprint
-
- print "fingerprint" = ", $rr->fingerprint, "\n";
-
-Returns the SHA1 fingerprint over the label and key in hexadecimal
-representation.
-
-
-=head2 fpbin
-
- $fpbin = $rr->fpbin;
-
-Returns the fingerprint as binary material.
-
-
-=head2 fptype
-
- print "fingerprint type" . " = " . $rr->fptype ."\n";
-
-Returns the fingerprint type of the SSHFP RR.
-
-=head2 babble
-
- print $rr->babble;
-
-If Digest::BubbleBabble is available on the sytem this method returns the
-'BabbleBubble' representation of the fingerprint. The 'BabbleBubble'
-string may be handy for telephone confirmation.
-
-The 'BabbleBubble' string returned as a comment behind the RDATA when
-the string method is called.
-
-The method returns an empty string if Digest::BubbleBable is not installed.
-
-=head1 TODO
-
-=head1 ACKNOWLEDGEMENT
-
-Jakob Schlyter for code review and supplying patches.
-
-=head1 COPYRIGHT
-
-Copyright (c) 2004 RIPE NCC, Olaf Kolkman.
-
-"All rights reserved, This program is free software; you may redistribute it
-and/or modify it under the same terms as Perl itself.
-
-=head1 SEE ALSO
-
-L<perl(1)>, L<Net::DNS>, L<Net::DNS::Resolver>, L<Net::DNS::Packet>,
-L<Net::DNS::Header>, L<Net::DNS::Question>, L<Net::DNS::RR>,
-draft-ietf-dnssext-delegation-signer
-
-=cut
-
-
-
-
-
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/TKEY.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/TKEY.pm
deleted file mode 100644
index 7bf838bb8e5..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/TKEY.pm
+++ /dev/null
@@ -1,208 +0,0 @@
-package Net::DNS::RR::TKEY;
-#
-# $Id: TKEY.pm 388 2005-06-22 10:06:05Z olaf $
-#
-use strict;
-BEGIN {
- eval { require bytes; }
-}
-use vars qw(@ISA $VERSION);
-
-use Digest::HMAC_MD5;
-use MIME::Base64;
-
-@ISA = qw(Net::DNS::RR);
-$VERSION = (qw$LastChangedRevision: 388 $)[1];
-
-sub new {
- my ($class, $self, $data, $offset) = @_;
-
- # if we have some data then we are parsing an incoming TKEY packet
- # see RFC2930 for the packet format
- if ($self->{"rdlength"} > 0) {
- ($self->{"algorithm"}, $offset) = Net::DNS::Packet::dn_expand($data, $offset);
-
- @{$self}{qw(inception expiration)} = unpack("\@$offset NN", $$data);
- $offset += Net::DNS::INT32SZ() + Net::DNS::INT32SZ();
-
- @{$self}{qw(inception expiration)} = unpack("\@$offset nn", $$data);
- $offset += Net::DNS::INT16SZ() + Net::DNS::INT16SZ();
-
- my ($key_len) = unpack("\@$offset n", $$data);
- $offset += Net::DNS::INT16SZ();
- $self->{"key"} = substr($$data, $offset, $key_len);
- $offset += $key_len;
-
- my ($other_len) = unpack("\@$offset n", $$data);
- $offset += Net::DNS::INT16SZ();
- $self->{"other_data"} = substr($$data, $offset, $other_len);
- $offset += $other_len;
- }
-
- return bless $self, $class;
-}
-
-sub new_from_string {
- my ($class, $self, $string) = @_;
-
- if ($string && ($string =~ /^(.*)$/)) {
- $self->{"key"} = $1;
- }
-
- $self->{"algorithm"} = "gss.microsoft.com";
- $self->{"inception"} = time;
- $self->{"expiration"} = time + 24*60*60;
- $self->{"mode"} = 3; # GSSAPI
- $self->{"error"} = 0;
- $self->{"other_len"} = 0;
- $self->{"other_data"} = "";
-
- return bless $self, $class;
-}
-
-sub error {
- my $self = shift;
-
- my $rcode;
- my $error = $self->{"error"};
-
- if (defined($error)) {
- $rcode = $Net::DNS::rcodesbyval{$error} || $error;
- }
-
- return $rcode;
-}
-
-sub rdatastr {
- my $self = shift;
-
- my $error = $self->error;
- $error = "UNDEFINED" unless defined $error;
-
- my $rdatastr;
-
- if (exists $self->{"algorithm"}) {
- $rdatastr = "$self->{algorithm}. $error";
- if ($self->{"other_len"} && defined($self->{"other_data"})) {
- $rdatastr .= " $self->{other_data}";
- }
- } else {
- $rdatastr = '';
- }
-
- return $rdatastr;
-}
-
-sub rr_rdata {
- my ($self, $packet, $offset) = @_;
- my $rdata = "";
-
- $packet->{"compnames"} = {};
- $rdata .= $packet->dn_comp($self->{"algorithm"}, 0);
- $rdata .= pack("N", $self->{"inception"});
- $rdata .= pack("N", $self->{"expiration"});
- $rdata .= pack("n", $self->{"mode"});
- $rdata .= pack("n", 0); # error
- $rdata .= pack("n", length($self->{"key"}));
- $rdata .= $self->{"key"};
- $rdata .= pack("n", length($self->{"other_data"}));
- $rdata .= $self->{"other_data"};
-
- return $rdata;
-}
-
-1;
-__END__
-
-=head1 NAME
-
-Net::DNS::RR::TKEY - DNS TKEY resource record
-
-=head1 SYNOPSIS
-
-C<use Net::DNS::RR>;
-
-=head1 DESCRIPTION
-
-Class for DNS TKEY resource records.
-
-=head1 METHODS
-
-=head2 algorithm
-
- $rr->algorithm($algorithm_name);
- print "algorithm = ", $rr->algorithm, "\n";
-
-Gets or sets the domain name that specifies the name of the algorithm.
-The default algorithm is gss.microsoft.com
-
-=head2 inception
-
- $rr->inception(time);
- print "inception = ", $rr->inception, "\n";
-
-Gets or sets the inception time as the number of seconds since 1 Jan 1970
-00:00:00 UTC.
-
-The default inception time is the current time.
-
-=head2 expiration
-
- $rr->expiration(time);
- print "expiration = ", $rr->expiration, "\n";
-
-Gets or sets the expiration time as the number of seconds since 1 Jan 1970
-00:00:00 UTC.
-
-The default expiration time is the current time plus 1 day.
-
-=head2 mode
-
- $rr->mode(3);
- print "mode = ", $rr->mode, "\n";
-
-Sets the key mode (see rfc2930). The default is 3 which corresponds to GSSAPI
-
-=head2 error
-
- print "error = ", $rr->error, "\n";
-
-Returns the RCODE covering TKEY processing. See RFC 2930 for details.
-
-=head2 other_len
-
- print "other len = ", $rr->other_len, "\n";
-
-Returns the length of the Other Data. Should be zero.
-
-=head2 other_data
-
- print "other data = ", $rr->other_data, "\n";
-
-Returns the Other Data. This field should be empty.
-
-=head1 BUGS
-
-This code has not been extensively tested. Use with caution on
-production systems. See http://samba.org/ftp/samba/tsig-gss/ for an
-example usage.
-
-=head1 COPYRIGHT
-
-Copyright (c) 2000 Andrew Tridgell. All rights reserved. This program
-is free software; you can redistribute it and/or modify it under
-the same terms as Perl itself.
-
-=head1 ACKNOWLEDGMENT
-
-The Net::DNS::RR::TKEY module is based on the TSIG module by Michael
-Fuhr and Chris Turbeville.
-
-=head1 SEE ALSO
-
-L<perl(1)>, L<Net::DNS>, L<Net::DNS::Resolver>, L<Net::DNS::Packet>,
-L<Net::DNS::Header>, L<Net::DNS::Question>, L<Net::DNS::RR>,
-RFC 2845
-
-=cut
-
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/TSIG.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/TSIG.pm
deleted file mode 100644
index 844072fd170..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/TSIG.pm
+++ /dev/null
@@ -1,353 +0,0 @@
-package Net::DNS::RR::TSIG;
-#
-# $Id: TSIG.pm 388 2005-06-22 10:06:05Z olaf $
-#
-use strict;
-BEGIN {
- eval { require bytes; }
-}
-use vars qw(@ISA $VERSION);
-
-use Digest::HMAC_MD5;
-use MIME::Base64;
-
-use constant DEFAULT_ALGORITHM => "HMAC-MD5.SIG-ALG.REG.INT";
-use constant DEFAULT_FUDGE => 300;
-
-@ISA = qw(Net::DNS::RR);
-$VERSION = (qw$LastChangedRevision: 388 $)[1];
-
-# a signing function for the HMAC-MD5 algorithm. This can be overridden using
-# the sign_func element
-sub sign_hmac {
- my ($key, $data) = @_;
-
- $key =~ s/ //g;
- $key = decode_base64($key);
-
- my $hmac = Digest::HMAC_MD5->new($key);
- $hmac->add($data);
-
- return $hmac->digest;
-}
-
-sub new {
- my ($class, $self, $data, $offset) = @_;
-
- if ($self->{"rdlength"} > 0) {
- ($self->{"algorithm"}, $offset) = Net::DNS::Packet::dn_expand($data, $offset);
-
- my ($time_high, $time_low) = unpack("\@$offset nN", $$data);
- $self->{"time_signed"} = $time_low; # bug
- $offset += Net::DNS::INT16SZ() + Net::DNS::INT32SZ();
-
- @{$self}{qw(fudge mac_size)} = unpack("\@$offset nn", $$data);
- $offset += Net::DNS::INT16SZ() + Net::DNS::INT16SZ();
-
- $self->{"mac"} = substr($$data, $offset, $self->{'mac_size'});
- $offset += $self->{'mac_size'};
-
- @{$self}{qw(original_id error other_len)} = unpack("\@$offset nnn", $$data);
- $offset += Net::DNS::INT16SZ() * 3;
-
- my $odata = substr($$data, $offset, $self->{'other_len'});
- my ($odata_high, $odata_low) = unpack("nN", $odata);
- $self->{"other_data"} = $odata_low;
- }
-
- return bless $self, $class;
-}
-
-sub new_from_string {
- my ($class, $self, $string) = @_;
-
- if ($string && ($string =~ /^(.*)$/)) {
- $self->{"key"} = $1;
- }
-
- $self->{"algorithm"} = DEFAULT_ALGORITHM;
- $self->{"time_signed"} = time;
- $self->{"fudge"} = DEFAULT_FUDGE;
- $self->{"mac_size"} = 0;
- $self->{"mac"} = "";
- $self->{"original_id"} = 0;
- $self->{"error"} = 0;
- $self->{"other_len"} = 0;
- $self->{"other_data"} = "";
- $self->{"sign_func"} = \&sign_hmac;
-
- # RFC 2845 Section 2.3
- $self->{"class"} = "ANY";
-
- return bless $self, $class;
-}
-
-sub error {
- my $self = shift;
-
- my $rcode;
- my $error = $self->{"error"};
-
- if (defined($error)) {
- $rcode = $Net::DNS::rcodesbyval{$error} || $error;
- }
-
- return $rcode;
-}
-
-sub mac_size {
- my $self = shift;
- return length(defined($self->{"mac"}) ? $self->{"mac"} : "");
-}
-
-sub mac {
- my $self = shift;
- my $mac = unpack("H*", $self->{"mac"}) if defined($self->{"mac"});
- return $mac;
-}
-
-sub rdatastr {
- my $self = shift;
-
- my $error = $self->error;
- $error = "UNDEFINED" unless defined $error;
-
- my $rdatastr;
-
- if (exists $self->{"algorithm"}) {
- $rdatastr = "$self->{algorithm}. $error";
- if ($self->{"other_len"} && defined($self->{"other_data"})) {
- $rdatastr .= " $self->{other_data}";
- }
- } else {
- $rdatastr = "";
- }
-
- return $rdatastr;
-}
-
-# return the data that needs to be signed/verified. This is useful for
-# external TSIG verification routines
-sub sig_data {
- my ($self, $packet) = @_;
- my ($newpacket, $sigdata);
-
- # XXX this is horrible. $pkt = Net::DNS::Packet->clone($packet); maybe?
- bless($newpacket = {},"Net::DNS::Packet");
- %{$newpacket} = %{$packet};
- bless($newpacket->{"header"} = {},"Net::DNS::Header");
- $newpacket->{"additional"} = [];
- %{$newpacket->{"header"}} = %{$packet->{"header"}};
- @{$newpacket->{"additional"}} = @{$packet->{"additional"}};
- shift(@{$newpacket->{"additional"}});
- $newpacket->{"header"}{"arcount"}--;
- $newpacket->{"compnames"} = {};
-
- # Add the request MAC if present (used to validate responses).
- $sigdata .= pack("H*", $self->{"request_mac"})
- if $self->{"request_mac"};
-
- $sigdata .= $newpacket->data;
-
- # Don't compress the record (key) name.
- my $tmppacket = Net::DNS::Packet->new("");
- $sigdata .= $tmppacket->dn_comp(lc($self->{"name"}), 0);
-
- $sigdata .= pack("n", $Net::DNS::classesbyname{uc($self->{"class"})});
- $sigdata .= pack("N", $self->{"ttl"});
-
- # Don't compress the algorithm name.
- $tmppacket->{"compnames"} = {};
- $sigdata .= $tmppacket->dn_comp(lc($self->{"algorithm"}), 0);
-
- $sigdata .= pack("nN", 0, $self->{"time_signed"}); # bug
- $sigdata .= pack("n", $self->{"fudge"});
- $sigdata .= pack("nn", $self->{"error"}, $self->{"other_len"});
-
- $sigdata .= pack("nN", 0, $self->{"other_data"})
- if $self->{"other_data"};
-
- return $sigdata;
-}
-
-sub rr_rdata {
- my ($self, $packet, $offset) = @_;
- my $rdata = "";
-
- if (exists $self->{"key"}) {
- # form the data to be signed
- my $sigdata = $self->sig_data($packet);
-
- # and call the signing function
- $self->{"mac"} = &{$self->{"sign_func"}}($self->{"key"}, $sigdata);
- $self->{"mac_size"} = length($self->{"mac"});
-
- # construct the signed TSIG record
- $packet->{"compnames"} = {};
- $rdata .= $packet->dn_comp($self->{"algorithm"}, 0);
-
- $rdata .= pack("nN", 0, $self->{"time_signed"}); # bug
- $rdata .= pack("nn", $self->{"fudge"}, $self->{"mac_size"});
- $rdata .= $self->{"mac"};
-
- $rdata .= pack("nnn",($packet->{"header"}->{"id"},
- $self->{"error"},
- $self->{"other_len"}));
-
- $rdata .= pack("nN", 0, $self->{"other_data"})
- if $self->{"other_data"};
- }
-
- return $rdata;
-}
-
-1;
-__END__
-
-=head1 NAME
-
-Net::DNS::RR::TSIG - DNS TSIG resource record
-
-=head1 SYNOPSIS
-
-C<use Net::DNS::RR>;
-
-=head1 DESCRIPTION
-
-Class for DNS Transaction Signature (TSIG) resource records.
-
-=head1 METHODS
-
-=head2 algorithm
-
- $rr->algorithm($algorithm_name);
- print "algorithm = ", $rr->algorithm, "\n";
-
-Gets or sets the domain name that specifies the name of the algorithm.
-The only algorithm currently supported is HMAC-MD5.SIG-ALG.REG.INT.
-
-=head2 time_signed
-
- $rr->time_signed(time);
- print "time signed = ", $rr->time_signed, "\n";
-
-Gets or sets the signing time as the number of seconds since 1 Jan 1970
-00:00:00 UTC.
-
-The default signing time is the current time.
-
-=head2 fudge
-
- $rr->fudge(60);
- print "fudge = ", $rr->fudge, "\n";
-
-Gets or sets the "fudge", i.e., the seconds of error permitted in the
-signing time.
-
-The default fudge is 300 seconds.
-
-=head2 mac_size
-
- print "MAC size = ", $rr->mac_size, "\n";
-
-Returns the number of octets in the message authentication code (MAC).
-The programmer must call a Net::DNS::Packet object's data method
-before this will return anything meaningful.
-
-=head2 mac
-
- print "MAC = ", $rr->mac, "\n";
-
-Returns the message authentication code (MAC) as a string of hex
-characters. The programmer must call a Net::DNS::Packet object's
-data method before this will return anything meaningful.
-
-=head2 original_id
-
- $rr->original_id(12345);
- print "original ID = ", $rr->original_id, "\n";
-
-Gets or sets the original message ID.
-
-=head2 error
-
- print "error = ", $rr->error, "\n";
-
-Returns the RCODE covering TSIG processing. Common values are
-NOERROR, BADSIG, BADKEY, and BADTIME. See RFC 2845 for details.
-
-=head2 other_len
-
- print "other len = ", $rr->other_len, "\n";
-
-Returns the length of the Other Data. Should be zero unless the
-error is BADTIME.
-
-=head2 other_data
-
- print "other data = ", $rr->other_data, "\n";
-
-Returns the Other Data. This field should be empty unless the
-error is BADTIME, in which case it will contain the server's
-time as the number of seconds since 1 Jan 1970 00:00:00 UTC.
-
-=head2 sig_data
-
- my $sigdata = $tsig->sig_data($packet);
-
-Returns the packet packed according to RFC2845 in a form for signing. This
-is only needed if you want to supply an external signing function, such as is
-needed for TSIG-GSS.
-
-=head2 sign_func
-
- sub my_sign_fn($$) {
- my ($key, $data) = @_;
-
- return some_digest_algorithm($key, $data);
- }
-
- $tsig->sign_func(\&my_sign_fn);
-
-This sets the signing function to be used for this TSIG record.
-
-The default signing function is HMAC-MD5.
-
-=head1 BUGS
-
-This code is still under development. Use with caution on production
-systems.
-
-The time_signed and other_data fields should be 48-bit unsigned
-integers (RFC 2845, Sections 2.3 and 4.5.2). The current implementation
-ignores the upper 16 bits; this will cause problems for times later
-than 19 Jan 2038 03:14:07 UTC.
-
-The only builtin algorithm currently supported is
-HMAC-MD5.SIG-ALG.REG.INT. You can use other algorithms by supplying an
-appropriate sign_func.
-
-=head1 COPYRIGHT
-
-Copyright (c) 2002 Michael Fuhr.
-
-Portions Copyright (c) 2002-2004 Chris Reinhardt.
-
-All rights reserved. This program is free software; you may redistribute
-it and/or modify it under the same terms as Perl itself.
-
-=head1 ACKNOWLEDGMENT
-
-Most of the code in the Net::DNS::RR::TSIG module was contributed
-by Chris Turbeville.
-
-Support for external signing functions was added by Andrew Tridgell.
-
-=head1 SEE ALSO
-
-L<perl(1)>, L<Net::DNS>, L<Net::DNS::Resolver>, L<Net::DNS::Packet>,
-L<Net::DNS::Header>, L<Net::DNS::Question>, L<Net::DNS::RR>,
-RFC 2845
-
-=cut
-
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/TXT.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/TXT.pm
deleted file mode 100644
index 1c8eb78e3b4..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/TXT.pm
+++ /dev/null
@@ -1,179 +0,0 @@
-package Net::DNS::RR::TXT;
-#
-# $Id: TXT.pm 582 2006-04-25 07:12:19Z olaf $
-#
-use strict;
-BEGIN {
- eval { require bytes; }
-}
-use vars qw(@ISA $VERSION);
-
-use Text::ParseWords;
-
-@ISA = qw(Net::DNS::RR);
-$VERSION = (qw$LastChangedRevision: 582 $)[1];
-
-sub new {
- my ($class, $self, $data, $offset) = @_;
-
- my $rdlength = $self->{'rdlength'} or return bless $self, $class;
- my $end = $offset + $rdlength;
-
- while ($offset < $end) {
- my $strlen = unpack("\@$offset C", $$data);
- ++$offset;
-
- my $char_str = substr($$data, $offset, $strlen);
- $offset += $strlen;
-
- push(@{$self->{'char_str_list'}}, $char_str);
- }
-
- return bless $self, $class;
-}
-
-sub new_from_string {
- my ( $class, $self, $rdata_string ) = @_ ;
-
- bless $self, $class;
-
- $self->_build_char_str_list($rdata_string);
-
- return $self;
-}
-
-sub txtdata {
- my $self = shift;
- return join(' ', $self->char_str_list());
-}
-
-sub rdatastr {
- my $self = shift;
-
- if ($self->char_str_list) {
- return join(' ', map {
- my $str = $_;
- $str =~ s/"/\\"/g;
- qq("$str");
- } @{$self->{'char_str_list'}});
- }
-
- return '';
-}
-
-sub _build_char_str_list {
- my ($self, $rdata_string) = @_;
-
- my @words;
-
- @words= shellwords($rdata_string) if $rdata_string;
-
- $self->{'char_str_list'} = [];
-
- if (@words) {
- foreach my $string (@words) {
- $string =~ s/\\"/"/g;
- push(@{$self->{'char_str_list'}}, $string);
- }
- }
-}
-
-sub char_str_list {
- my $self = shift;
-
- if (not $self->{'char_str_list'}) {
- $self->_build_char_str_list( $self->{'txtdata'} );
- }
-
- return @{$self->{'char_str_list'}}; # unquoted strings
-}
-
-sub rr_rdata {
- my $self = shift;
- my $rdata = '';
-
- foreach my $string ($self->char_str_list) {
- $rdata .= pack("C", length $string );
- $rdata .= $string;
- }
-
- return $rdata;
-}
-
-1;
-__END__
-
-=head1 NAME
-
-Net::DNS::RR::TXT - DNS TXT resource record
-
-=head1 SYNOPSIS
-
-C<use Net::DNS::RR>;
-
-=head1 DESCRIPTION
-
-Class for DNS Text (TXT) resource records.
-
-=head1 METHODS
-
-=head2 txtdata
-
- print "txtdata = ", $rr->txtdata, "\n";
-
-Returns the descriptive text as a single string, regardless of actual
-number of <character-string> elements. Of questionable value. Should
-be deprecated.
-
-Use C<< $txt->rdatastr() >> or C<< $txt->char_str_list() >> instead.
-
-
-=head2 char_str_list
-
- print "Individual <character-string> list: \n\t",
- join("\n\t", $rr->char_str_list());
-
-Returns a list of the individual <character-string> elements,
-as unquoted strings. Used by TXT->rdatastr and TXT->rr_rdata.
-
-
-=head1 FEATURES
-
-The RR.pm module accepts semi-colons as a start of a comment. This is
-to allow the RR.pm to deal with RFC1035 specified zonefile format.
-
-For some applications of the TXT RR the semicolon is relevant, you
-will need to escape it on input.
-
-Also note that you should specify the several character strings
-separately. The easiest way to do so is to include the whole argument
-in single quotes and the several character strings in double
-quotes. Double quotes inside the character strings will need to be
-escaped.
-
-my $TXTrr=Net::DNS::RR->new('txt2.t.net-dns.org. 60 IN
- TXT "Test1 \" \; more stuff" "Test2"');
-
-would result in
-$TXTrr->char_str_list())[0] containing 'Test1 " ; more stuff'
-and
-$TXTrr->char_str_list())[1] containing 'Test2'
-
-
-=head1 COPYRIGHT
-
-Copyright (c) 1997-2002 Michael Fuhr.
-
-Portions Copyright (c) 2002-2004 Chris Reinhardt.
-Portions Copyright (c) 2005 Olaf Kolkman (NLnet Labs)
-
-All rights reserved. This program is free software; you may redistribute
-it and/or modify it under the same terms as Perl itself.
-
-=head1 SEE ALSO
-
-L<perl(1)>, L<Net::DNS>, L<Net::DNS::Resolver>, L<Net::DNS::Packet>,
-L<Net::DNS::Header>, L<Net::DNS::Question>, L<Net::DNS::RR>,
-RFC 1035 Section 3.3.14
-
-=cut
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/Unknown.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/Unknown.pm
deleted file mode 100644
index 5a32f1ff87f..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/Unknown.pm
+++ /dev/null
@@ -1,82 +0,0 @@
-package Net::DNS::RR::Unknown;
-#
-# $Id: Unknown.pm 388 2005-06-22 10:06:05Z olaf $
-#
-use strict;
-BEGIN {
- eval { require bytes; }
-}
-use vars qw(@ISA $VERSION);
-
-@ISA = qw(Net::DNS::RR);
-$VERSION = (qw$LastChangedRevision: 388 $)[1];
-
-sub new {
- my ($class, $self, $data, $offset) = @_;
-
- my $length = $self->{'rdlength'};
-
- if ($length > 0) {
- $self->{'rdata'} = substr($$data, $offset,$length);
- $self->{'rdatastr'} = "\\# $length " . unpack('H*', $self->{'rdata'});
- }
-
- return bless $self, $class;
-}
-
-
-sub rdatastr {
- my $self = shift;
-
- if (exists $self->{'rdatastr'}) {
- return $self->{'rdatastr'};
- } else {
- if (exists $self->{"rdata"}){
- my $data= $self->{'rdata'};
-
- return "\\# ". length($data) . " " . unpack('H*', $data);
- }
- }
-
- return "#NO DATA";
-}
-
-
-# sub rr_rdata is inherited from RR.pm. Note that $self->{'rdata'}
-# should always be defined
-
-
-
-1;
-__END__
-
-=head1 NAME
-
-Net::DNS::RR::Unknown - Unknown RR record
-
-=head1 SYNOPSIS
-
-C<use Net::DNS::RR>;
-
-=head1 DESCRIPTION
-
-Class for dealing with unknown RR types (RFC3597)
-
-=head1 METHODS
-
-=head1 COPYRIGHT
-
-Copyright (c) 1997-2002 Michael Fuhr.
-
-Portions Copyright (c) 2002-2004 Chris Reinhardt.
-
-Portions Copyright (c) 2003 Olaf M. Kolkman, RIPE NCC.
-
-All rights reserved. This program is free software; you may redistribute
-it and/or modify it under the same terms as Perl itself.
-
-=head1 SEE ALSO
-
-L<Net::DNS>, L<Net::DNS::RR>, RFC 3597
-
-=cut
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/X25.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/X25.pm
deleted file mode 100644
index 97841a836db..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/X25.pm
+++ /dev/null
@@ -1,95 +0,0 @@
-package Net::DNS::RR::X25;
-#
-# $Id: X25.pm 388 2005-06-22 10:06:05Z olaf $
-#
-use strict;
-BEGIN {
- eval { require bytes; }
-}
-use vars qw(@ISA $VERSION);
-
-@ISA = qw(Net::DNS::RR);
-$VERSION = (qw$LastChangedRevision: 388 $)[1];
-
-sub new {
- my ($class, $self, $data, $offset) = @_;
-
- if ($self->{"rdlength"} > 0) {
- my ($len) = unpack("\@$offset C", $$data);
- ++$offset;
- $self->{"psdn"} = substr($$data, $offset, $len);
- $offset += $len;
- }
-
- return bless $self, $class;
-}
-
-sub new_from_string {
- my ($class, $self, $string) = @_;
-
- if ($string && $string =~ /^\s*["']?(.*?)["']?\s*$/) {
- $self->{"psdn"} = $1;
- }
-
- return bless $self, $class;
-}
-
-sub rdatastr {
- my $self = shift;
-
- return exists $self->{"psdn"}
- ? qq("$self->{psdn}")
- : '';
-}
-
-sub rr_rdata {
- my $self = shift;
- my $rdata = "";
-
- if (exists $self->{"psdn"}) {
- $rdata .= pack("C", length $self->{"psdn"});
- $rdata .= $self->{"psdn"};
- }
-
- return $rdata;
-}
-
-1;
-__END__
-
-=head1 NAME
-
-Net::DNS::RR::X25 - DNS X25 resource record
-
-=head1 SYNOPSIS
-
-C<use Net::DNS::RR>;
-
-=head1 DESCRIPTION
-
-Class for DNS X25 resource records.
-
-=head1 METHODS
-
-=head2 psdn
-
- print "psdn = ", $rr->psdn, "\n";
-
-Returns the PSDN address.
-
-=head1 COPYRIGHT
-
-Copyright (c) 1997-2002 Michael Fuhr.
-
-Portions Copyright (c) 2002-2004 Chris Reinhardt.
-
-All rights reserved. This program is free software; you may redistribute
-it and/or modify it under the same terms as Perl itself.
-
-=head1 SEE ALSO
-
-L<perl(1)>, L<Net::DNS>, L<Net::DNS::Resolver>, L<Net::DNS::Packet>,
-L<Net::DNS::Header>, L<Net::DNS::Question>, L<Net::DNS::RR>,
-RFC 1183 Section 3.1
-
-=cut
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/Resolver.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/Resolver.pm
deleted file mode 100644
index c64d472445b..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/Resolver.pm
+++ /dev/null
@@ -1,750 +0,0 @@
-package Net::DNS::Resolver;
-#
-# $Id: Resolver.pm 614 2006-09-25 08:12:29Z olaf $
-#
-
-use strict;
-use vars qw($VERSION @ISA);
-
-$VERSION = (qw$LastChangedRevision: 614 $)[1];
-
-BEGIN {
- if ($^O eq 'MSWin32') {
- require Net::DNS::Resolver::Win32;
- @ISA = qw(Net::DNS::Resolver::Win32);
- } elsif ($^O eq 'cygwin') {
- require Net::DNS::Resolver::Cygwin;
- @ISA = qw(Net::DNS::Resolver::Cygwin);
- } else {
- require Net::DNS::Resolver::UNIX;
- @ISA = qw(Net::DNS::Resolver::UNIX);
- }
-}
-
-__PACKAGE__->init();
-
-1;
-
-__END__
-
-=head1 NAME
-
-Net::DNS::Resolver - DNS resolver class
-
-=head1 SYNOPSIS
-
- use Net::DNS;
-
- my $res = Net::DNS::Resolver->new;
-
- # Perform a lookup, using the searchlist if appropriate.
- my $answer = $res->search('example.com');
-
- # Perform a lookup, without the searchlist
- my $answer = $res->query('example.com', 'MX');
-
- # Perform a lookup, without pre or post-processing
- my $answer = $res->send('example.com', 'MX', 'CH');
-
- # Send a prebuilt packet
- my $packet = Net::DNS::Packet->new(...);
- my $answer = $res->send($packet);
-
-=head1 DESCRIPTION
-
-Instances of the C<Net::DNS::Resolver> class represent resolver objects.
-A program can have multiple resolver objects, each maintaining its
-own state information such as the nameservers to be queried, whether
-recursion is desired, etc.
-
-=head1 METHODS
-
-=head2 new
-
- # Use the system defaults
- my $res = Net::DNS::Resolver->new;
-
- # Use my own configuration file
- my $res = Net::DNS::Resolver->new(config_file => '/my/dns.conf');
-
- # Set options in the constructor
- my $res = Net::DNS::Resolver->new(
- nameservers => [qw(10.1.1.128 10.1.2.128)],
- recurse => 0,
- debug => 1,
- );
-
-Returns a resolver object. If given no arguments, C<new()> returns an
-object configured to your system's defaults. On UNIX systems the
-defaults are read from the following files, in the order indicated:
-
- /etc/resolv.conf
- $HOME/.resolv.conf
- ./.resolv.conf
-
-The following keywords are recognized in resolver configuration files:
-
-=over 4
-
-=item domain
-
-The default domain.
-
-=item search
-
-A space-separated list of domains to put in the search list.
-
-=item nameserver
-
-A space-separated list of nameservers to query.
-
-=back
-
-Files except for F</etc/resolv.conf> must be owned by the effective
-userid running the program or they won't be read. In addition, several
-environment variables can also contain configuration information; see
-L</ENVIRONMENT>.
-
-On Windows systems, an attempt is made to determine the system defaults
-using the registry. This is still a work in progress; systems with many
-dynamically configured network interfaces may confuse Net::DNS.
-
-You can include a configuration file of your own when creating a
-resolver object:
-
- # Use my own configuration file
- my $res = Net::DNS::Resolver->new(config_file => '/my/dns.conf');
-
-This is supported on both UNIX and Windows. Values pulled from a custom
-configuration file override the the system's defaults, but can still be
-overridden by the other arguments to new().
-
-Explicit arguments to new override both the system's defaults and the
-values of the custom configuration file, if any. The following
-arguments to new() are supported:
-
-=over 4
-
-=item nameservers
-
-An array reference of nameservers to query.
-
-=item searchlist
-
-An array reference of domains.
-
-=item recurse
-
-=item debug
-
-=item domain
-
-=item port
-
-=item srcaddr
-
-=item srcport
-
-=item tcp_timeout
-
-=item udp_timeout
-
-=item retrans
-
-=item retry
-
-=item usevc
-
-=item stayopen
-
-=item igntc
-
-=item defnames
-
-=item dnsrch
-
-=item persistent_tcp
-
-=item persistent_udp
-
-=item dnssec
-
-=back
-
-For more information on any of these options, please consult the method
-of the same name.
-
-=head2 search
-
- $packet = $res->search('mailhost');
- $packet = $res->search('mailhost.example.com');
- $packet = $res->search('192.168.1.1');
- $packet = $res->search('example.com', 'MX');
- $packet = $res->search('user.passwd.example.com', 'TXT', 'HS');
-
-Performs a DNS query for the given name, applying the searchlist
-if appropriate. The search algorithm is as follows:
-
-=over 4
-
-=item 1.
-
-If the name contains at least one dot, try it as is.
-
-=item 2.
-
-If the name doesn't end in a dot then append each item in
-the search list to the name. This is only done if B<dnsrch>
-is true.
-
-=item 3.
-
-If the name doesn't contain any dots, try it as is.
-
-=back
-
-The record type and class can be omitted; they default to A and
-IN. If the name looks like an IP address (4 dot-separated numbers),
-then an appropriate PTR query will be performed.
-
-Returns a "Net::DNS::Packet" object, or "undef" if no answers were
-found. If you need to examine the response packet whether it contains
-any answers or not, use the send() method instead.
-
-=head2 query
-
- $packet = $res->query('mailhost');
- $packet = $res->query('mailhost.example.com');
- $packet = $res->query('192.168.1.1');
- $packet = $res->query('example.com', 'MX');
- $packet = $res->query('user.passwd.example.com', 'TXT', 'HS');
-
-Performs a DNS query for the given name; the search list is not
-applied. If the name doesn't contain any dots and B<defnames>
-is true then the default domain will be appended.
-
-The record type and class can be omitted; they default to A and
-IN. If the name looks like an IP address (IPv4 or IPv6),
-then an appropriate PTR query will be performed.
-
-Returns a "Net::DNS::Packet" object, or "undef" if no answers were
-found. If you need to examine the response packet whether it contains
-any answers or not, use the send() method instead.
-
-=head2 send
-
- $packet = $res->send($packet_object);
- $packet = $res->send('mailhost.example.com');
- $packet = $res->send('example.com', 'MX');
- $packet = $res->send('user.passwd.example.com', 'TXT', 'HS');
-
-Performs a DNS query for the given name. Neither the searchlist
-nor the default domain will be appended.
-
-The argument list can be either a C<Net::DNS::Packet> object or a list
-of strings. The record type and class can be omitted; they default to
-A and IN. If the name looks like an IP address (Ipv4 or IPv6),
-then an appropriate PTR query will be performed.
-
-Returns a C<Net::DNS::Packet> object whether there were any answers or not.
-Use C<< $packet->header->ancount >> or C<< $packet->answer >> to find out
-if there were any records in the answer section. Returns C<undef> if there
-was an error.
-
-=head2 axfr
-
- @zone = $res->axfr;
- @zone = $res->axfr('example.com');
- @zone = $res->axfr('passwd.example.com', 'HS');
-
-Performs a zone transfer from the first nameserver listed in C<nameservers>.
-If the zone is omitted, it defaults to the first zone listed in the resolver's
-search list. If the class is omitted, it defaults to IN.
-
-Returns a list of C<Net::DNS::RR> objects, or C<undef> if the zone
-transfer failed.
-
-The redundant SOA record that terminates the zone transfer is not
-returned to the caller.
-
-See also L</axfr_start> and L</axfr_next>.
-
-Here's an example that uses a timeout:
-
- $res->tcp_timeout(10);
- my @zone = $res->axfr('example.com');
-
- if (@zone) {
- foreach my $rr (@zone) {
- $rr->print;
- }
- } else {
- print 'Zone transfer failed: ', $res->errorstring, "\n";
- }
-
-=head2 axfr_start
-
- $res->axfr_start;
- $res->axfr_start('example.com');
- $res->axfr_start('example.com', 'HS');
-
-Starts a zone transfer from the first nameserver listed in C<nameservers>.
-If the zone is omitted, it defaults to the first zone listed in the resolver's
-search list. If the class is omitted, it defaults to IN.
-
-B<IMPORTANT>:
-
-This method currently returns the C<IO::Socket::INET> object that will
-be used for reading, or C<undef> on error. DO NOT DEPEND ON C<axfr_start()>
-returning a socket object. THIS MIGHT CHANGE in future releases.
-
-Use C<axfr_next> to read the zone records one at a time.
-
-=head2 axfr_next
-
- $res->axfr_start('example.com');
-
- while (my $rr = $res->axfr_next) {
- $rr->print;
- }
-
-Reads records from a zone transfer one at a time.
-
-Returns C<undef> at the end of the zone transfer. The redundant
-SOA record that terminates the zone transfer is not returned.
-
-See also L</axfr>.
-
-=head2 nameservers
-
- @nameservers = $res->nameservers;
- $res->nameservers('192.168.1.1', '192.168.2.2', '192.168.3.3');
-
-Gets or sets the nameservers to be queried.
-
-Also see the IPv6 transport notes below
-
-=head2 print
-
- $res->print;
-
-Prints the resolver state on the standard output.
-
-=head2 string
-
- print $res->string;
-
-Returns a string representation of the resolver state.
-
-=head2 searchlist
-
- @searchlist = $res->searchlist;
- $res->searchlist('example.com', 'a.example.com', 'b.example.com');
-
-Gets or sets the resolver search list.
-
-=head2 port
-
- print 'sending queries to port ', $res->port, "\n";
- $res->port(9732);
-
-Gets or sets the port to which we send queries. This can be useful
-for testing a nameserver running on a non-standard port. The
-default is port 53.
-
-=head2 srcport
-
- print 'sending queries from port ', $res->srcport, "\n";
- $res->srcport(5353);
-
-Gets or sets the port from which we send queries. The default is 0,
-meaning any port.
-
-=head2 srcaddr
-
- print 'sending queries from address ', $res->srcaddr, "\n";
- $res->srcaddr('192.168.1.1');
-
-Gets or sets the source address from which we send queries. Convenient
-for forcing queries out a specific interfaces on a multi-homed host.
-The default is 0.0.0.0, meaning any local address.
-
-=head2 bgsend
-
- $socket = $res->bgsend($packet_object) || die " $res->errorstring";
-
- $socket = $res->bgsend('mailhost.example.com');
- $socket = $res->bgsend('example.com', 'MX');
- $socket = $res->bgsend('user.passwd.example.com', 'TXT', 'HS');
-
-
-
-Performs a background DNS query for the given name, i.e., sends a
-query packet to the first nameserver listed in C<< $res->nameservers >>
-and returns immediately without waiting for a response. The program
-can then perform other tasks while waiting for a response from the
-nameserver.
-
-The argument list can be either a C<Net::DNS::Packet> object or a list
-of strings. The record type and class can be omitted; they default to
-A and IN. If the name looks like an IP address (4 dot-separated numbers),
-then an appropriate PTR query will be performed.
-
-Returns an C<IO::Socket::INET> object or C<undef> on error in which
-case the reason for failure can be found through a call to the
-errorstring method.
-
-The program must determine when the socket is ready for reading and
-call C<< $res->bgread >> to get the response packet. You can use C<<
-$res->bgisready >> or C<IO::Select> to find out if the socket is ready
-before reading it.
-
-=head2 bgread
-
- $packet = $res->bgread($socket);
- undef $socket;
-
-Reads the answer from a background query (see L</bgsend>). The argument
-is an C<IO::Socket> object returned by C<bgsend>.
-
-Returns a C<Net::DNS::Packet> object or C<undef> on error.
-
-The programmer should close or destroy the socket object after reading it.
-
-=head2 bgisready
-
- $socket = $res->bgsend('foo.example.com');
- until ($res->bgisready($socket)) {
- # do some other processing
- }
- $packet = $res->bgread($socket);
- $socket = undef;
-
-Determines whether a socket is ready for reading. The argument is
-an C<IO::Socket> object returned by C<< $res->bgsend >>.
-
-Returns true if the socket is ready, false if not.
-
-=head2 tsig
-
- my $tsig = $res->tsig;
-
- $res->tsig(Net::DNS::RR->new("$key_name TSIG $key"));
-
- $tsig = Net::DNS::RR->new("$key_name TSIG $key");
- $tsig->fudge(60);
- $res->tsig($tsig);
-
- $res->tsig($key_name, $key);
-
- $res->tsig(0);
-
-Get or set the TSIG record used to automatically sign outgoing
-queries and updates. Call with an argument of 0 or '' to turn off
-automatic signing.
-
-The default resolver behavior is not to sign any packets. You must
-call this method to set the key if you'd like the resolver to sign
-packets automatically.
-
-You can also sign packets manually -- see the C<Net::DNS::Packet>
-and C<Net::DNS::Update> manual pages for examples. TSIG records
-in manually-signed packets take precedence over those that the
-resolver would add automatically.
-
-=head2 retrans
-
- print 'retrans interval: ', $res->retrans, "\n";
- $res->retrans(3);
-
-Get or set the retransmission interval. The default is 5.
-
-=head2 retry
-
- print 'number of tries: ', $res->retry, "\n";
- $res->retry(2);
-
-Get or set the number of times to try the query. The default is 4.
-
-=head2 recurse
-
- print 'recursion flag: ', $res->recurse, "\n";
- $res->recurse(0);
-
-Get or set the recursion flag. If this is true, nameservers will
-be requested to perform a recursive query. The default is true.
-
-=head2 defnames
-
- print 'defnames flag: ', $res->defnames, "\n";
- $res->defnames(0);
-
-Get or set the defnames flag. If this is true, calls to B<query> will
-append the default domain to names that contain no dots. The default
-is true.
-
-=head2 dnsrch
-
- print 'dnsrch flag: ', $res->dnsrch, "\n";
- $res->dnsrch(0);
-
-Get or set the dnsrch flag. If this is true, calls to B<search> will
-apply the search list. The default is true.
-
-=head2 debug
-
- print 'debug flag: ', $res->debug, "\n";
- $res->debug(1);
-
-Get or set the debug flag. If set, calls to B<search>, B<query>,
-and B<send> will print debugging information on the standard output.
-The default is false.
-
-=head2 usevc
-
- print 'usevc flag: ', $res->usevc, "\n";
- $res->usevc(1);
-
-Get or set the usevc flag. If true, then queries will be performed
-using virtual circuits (TCP) instead of datagrams (UDP). The default
-is false.
-
-=head2 tcp_timeout
-
- print 'TCP timeout: ', $res->tcp_timeout, "\n";
- $res->tcp_timeout(10);
-
-Get or set the TCP timeout in seconds. A timeout of C<undef> means
-indefinite. The default is 120 seconds (2 minutes).
-
-=head2 udp_timeout
-
- print 'UDP timeout: ', $res->udp_timeout, "\n";
- $res->udp_timeout(10);
-
-Get or set the UDP timeout in seconds. A timeout of C<undef> means
-the retry and retrans settings will be just utilized to perform the
-retries until they are exhausted. The default is C<undef>.
-
-=head2 persistent_tcp
-
- print 'Persistent TCP flag: ', $res->persistent_tcp, "\n";
- $res->persistent_tcp(1);
-
-Get or set the persistent TCP setting. If set to true, Net::DNS
-will keep a TCP socket open for each host:port to which it connects.
-This is useful if you're using TCP and need to make a lot of queries
-or updates to the same nameserver.
-
-This option defaults to false unless you're running under a
-SOCKSified Perl, in which case it defaults to true.
-
-=head2 persistent_udp
-
- print 'Persistent UDP flag: ', $res->persistent_udp, "\n";
- $res->persistent_udp(1);
-
-Get or set the persistent UDP setting. If set to true, Net::DNS
-will keep a single UDP socket open for all queries.
-This is useful if you're using UDP and need to make a lot of queries
-or updates.
-
-=head2 igntc
-
- print 'igntc flag: ', $res->igntc, "\n";
- $res->igntc(1);
-
-Get or set the igntc flag. If true, truncated packets will be
-ignored. If false, truncated packets will cause the query to
-be retried using TCP. The default is false.
-
-=head2 errorstring
-
- print 'query status: ', $res->errorstring, "\n";
-
-Returns a string containing the status of the most recent query.
-
-=head2 answerfrom
-
- print 'last answer was from: ', $res->answerfrom, "\n";
-
-Returns the IP address from which we received the last answer in
-response to a query.
-
-=head2 answersize
-
- print 'size of last answer: ', $res->answersize, "\n";
-
-Returns the size in bytes of the last answer we received in
-response to a query.
-
-
-=head2 dnssec
-
- print "dnssec flag: ", $res->dnssec, "\n";
- $res->dnssec(0);
-
-Enabled DNSSEC this will set the checking disabled flag in the query header
-and add EDNS0 data as in RFC2671 and RFC3225
-
-When set to true the answer and additional section of queries from
-secured zones will contain DNSKEY, NSEC and RRSIG records.
-
-Setting calling the dnssec method with a non-zero value will set the
-UDP packet size to the default value of 2048. If that is to small or
-to big for your environement you should call the udppacketsize()
-method immeditatly after.
-
- $res->dnssec(1); # turns on DNSSEC and sets udp packetsize to 2048
- $res->udppacketsize(1028); # lowers the UDP pakcet size
-
-The method will Croak::croak with the message "You called the
-Net::DNS::Resolver::dnssec() method but do not have Net::DNS::SEC
-installed at ..." if you call it without Net::DNS::SEC being in your
-@INC path.
-
-
-
-=head2 cdflag
-
- print "checking disabled flag: ", $res->dnssec, "\n";
- $res->dnssec(1);
- $res->cdflag(1);
-
-Sets or gets the CD bit for a dnssec query. This bit is always zero
-for non dnssec queries. When the dnssec is enabled the flag can be set
-to 1.
-
-=head2 udppacketsize
-
- print "udppacketsize: ", $res->udppacketsize, "\n";
- $res->udppacketsize(2048);
-
-udppacketsize will set or get the packet size. If set to a value greater than
-Net::DNS::PACKETSZ() an EDNS extension will be added indicating suppport for MTU path
-recovery.
-
-Default udppacketsize is Net::DNS::PACKETSZ() (512)
-
-=head1 CUSTOMIZING
-
-Net::DNS::Resolver is actually an empty subclass. At compile time a
-super class is chosen based on the current platform. A side benefit of
-this allows for easy modification of the methods in Net::DNS::Resolver.
-You simply add a method to the namespace!
-
-For example, if we wanted to cache lookups:
-
- package Net::DNS::Resolver;
-
- my %cache;
-
- sub search {
- my ($self, @args) = @_;
-
- return $cache{@args} ||= $self->SUPER::search(@args);
- }
-
-
-=head1 IPv6 transport
-
-The Net::DNS::Resolver library will use IPv6 transport if the
-appropriate libraries (Socket6 and IO::Socket::INET6) are available
-and the address the server tries to connect to is an IPv6 address.
-
-The print() will method will report if IPv6 transport is available.
-
-You can use the force_v4() method with a non-zero argument
-to force IPv4 transport.
-
-The nameserver() method has IPv6 dependend behavior. If IPv6 is not
-available or IPv4 transport has been forced the nameserver() method
-will only return IPv4 addresses.
-
-For example
-
- $res->nameservers('192.168.1.1', '192.168.2.2', '2001:610:240:0:53:0:0:3');
- $res->force_v4(1);
- print join (" ",$res->nameserver());
-
-Will print: 192.168.1.1 192.168.2.2
-
-
-
-
-=head1 ENVIRONMENT
-
-The following environment variables can also be used to configure
-the resolver:
-
-=head2 RES_NAMESERVERS
-
- # Bourne Shell
- RES_NAMESERVERS="192.168.1.1 192.168.2.2 192.168.3.3"
- export RES_NAMESERVERS
-
- # C Shell
- setenv RES_NAMESERVERS "192.168.1.1 192.168.2.2 192.168.3.3"
-
-A space-separated list of nameservers to query.
-
-=head2 RES_SEARCHLIST
-
- # Bourne Shell
- RES_SEARCHLIST="example.com sub1.example.com sub2.example.com"
- export RES_SEARCHLIST
-
- # C Shell
- setenv RES_SEARCHLIST "example.com sub1.example.com sub2.example.com"
-
-A space-separated list of domains to put in the search list.
-
-=head2 LOCALDOMAIN
-
- # Bourne Shell
- LOCALDOMAIN=example.com
- export LOCALDOMAIN
-
- # C Shell
- setenv LOCALDOMAIN example.com
-
-The default domain.
-
-=head2 RES_OPTIONS
-
- # Bourne Shell
- RES_OPTIONS="retrans:3 retry:2 debug"
- export RES_OPTIONS
-
- # C Shell
- setenv RES_OPTIONS "retrans:3 retry:2 debug"
-
-A space-separated list of resolver options to set. Options that
-take values are specified as I<option>:I<value>.
-
-=head1 BUGS
-
-Error reporting and handling needs to be improved.
-
-The current implementation supports TSIG only on outgoing packets.
-No validation of server replies is performed.
-
-bgsend does not honor the usevc flag and only uses UDP for transport.
-
-=head1 COPYRIGHT
-
-Copyright (c) 1997-2002 Michael Fuhr.
-
-Portions Copyright (c) 2002-2004 Chris Reinhardt.
-Portions Copyright (c) 2005 Olaf M. Kolkman, NLnet Labs.
-
-All rights reserved. This program is free software; you may redistribute
-it and/or modify it under the same terms as Perl itself.
-
-=head1 SEE ALSO
-
-L<perl(1)>, L<Net::DNS>, L<Net::DNS::Packet>, L<Net::DNS::Update>,
-L<Net::DNS::Header>, L<Net::DNS::Question>, L<Net::DNS::RR>,
-L<resolver(5)>, RFC 1035, RFC 1034 Section 4.3.5
-
-=cut
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/Resolver/Base.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/Resolver/Base.pm
deleted file mode 100644
index 09778d9d597..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/Resolver/Base.pm
+++ /dev/null
@@ -1,1579 +0,0 @@
-package Net::DNS::Resolver::Base;
-#
-# $Id: Base.pm 704 2008-02-06 21:30:59Z olaf $
-#
-
-use strict;
-
-BEGIN {
- eval { require bytes; }
-}
-
-use vars qw(
- $VERSION
- $has_inet6
- $AUTOLOAD
-);
-
-use Carp;
-use Config ();
-use Socket;
-use IO::Socket;
-use IO::Select;
-
-use Net::DNS;
-use Net::DNS::Packet;
-
-$VERSION = (qw$LastChangedRevision: 704 $)[1];
-
-
-#
-# A few implementation notes wrt IPv6 support.
-#
-# In general we try to be gracious to those stacks that do not have ipv6 support.
-# We test that by means of the availability of Socket6 and IO::Socket::INET6
-#
-
-
-# We have chosen to not use mapped IPv4 addresses, there seem to be
-# issues with this; as a result we have to use sockets for both
-# family types. To be able to deal with persistent sockets and
-# sockets of both family types we use an array that is indexed by the
-# socketfamily type to store the socket handlers. I think this could
-# be done more efficiently.
-
-
-# inet_pton is not available on WIN32, so we only use the getaddrinfo
-# call to translate IP addresses to socketaddress
-
-
-
-# Set the $force_inet4_only variable inside the BEGIN block to force
-# not to use the IPv6 stuff. You can use this for compatibility
-# test. We do not see a need to do this from the calling code.
-
-
-# Olaf Kolkman, RIPE NCC, December 2003.
-
-
-BEGIN {
- if (
- eval {require Socket6;} &&
- # INET6 prior to 2.01 will not work; sorry.
- eval {require IO::Socket::INET6; IO::Socket::INET6->VERSION("2.00");}
- ) {
- import Socket6;
- $has_inet6=1;
- }else{
- $has_inet6=0;
- }
- }
-
-
-
-
-
-
-#
-# Set up a closure to be our class data.
-#
-{
- my %defaults = (
- nameservers => ['127.0.0.1'],
- port => 53,
- srcaddr => '0.0.0.0',
- srcport => 0,
- domain => '',
- searchlist => [],
- retrans => 5,
- retry => 4,
- usevc => 0,
- stayopen => 0,
- igntc => 0,
- recurse => 1,
- defnames => 1,
- dnsrch => 1,
- debug => 0,
- errorstring => 'unknown error or no error',
- tsig_rr => undef,
- answerfrom => '',
- querytime => undef,
- tcp_timeout => 120,
- udp_timeout => undef,
- axfr_sel => undef,
- axfr_rr => [],
- axfr_soa_count => 0,
- persistent_tcp => 0,
- persistent_udp => 0,
- dnssec => 0,
- udppacketsize => 0, # The actual default is lower bound by Net::DNS::PACKETSZ
- cdflag => 1, # this is only used when {dnssec} == 1
- force_v4 => 0, # force_v4 is only relevant when we have
- # v6 support available
- ignqrid => 0, # normally packets with non-matching ID
- # or with the qr bit of are thrown away
- # in 'ignqrid' these packets are
- # are accepted.
- # USE WITH CARE, YOU ARE VULNARABLE TO
- # SPOOFING IF SET.
- # This is may be a temporary feature
- );
-
- # If we're running under a SOCKSified Perl, use TCP instead of UDP
- # and keep the sockets open.
- if ($Config::Config{'usesocks'}) {
- $defaults{'usevc'} = 1;
- $defaults{'persistent_tcp'} = 1;
- }
-
- sub defaults { \%defaults }
-}
-
-# These are the attributes that we let the user specify in the new().
-# We also deprecate access to these with AUTOLOAD (some may be useful).
-my %public_attr = map { $_ => 1 } qw(
- nameservers
- port
- srcaddr
- srcport
- domain
- searchlist
- retrans
- retry
- usevc
- stayopen
- igntc
- recurse
- defnames
- dnsrch
- debug
- tcp_timeout
- udp_timeout
- persistent_tcp
- persistent_udp
- dnssec
- ignqrid
-);
-
-
-sub new {
- my $class = shift;
- my $self = bless({ %{$class->defaults} }, $class);
-
- $self->_process_args(@_) if @_ and @_ % 2 == 0;
- return $self;
-}
-
-
-
-sub _process_args {
- my ($self, %args) = @_;
-
- if ($args{'config_file'}) {
- $self->read_config_file($args{'config_file'});
- }
-
- foreach my $attr (keys %args) {
- next unless $public_attr{$attr};
-
- if ($attr eq 'nameservers' || $attr eq 'searchlist') {
-
- die "Net::DNS::Resolver->new(): $attr must be an arrayref\n" unless
- defined($args{$attr}) && UNIVERSAL::isa($args{$attr}, 'ARRAY');
-
- }
-
- if ($attr eq 'nameservers') {
- $self->nameservers(@{$args{$attr}});
- } else {
- $self->{$attr} = $args{$attr};
- }
- }
-
-
-}
-
-
-
-
-
-#
-# Some people have reported that Net::DNS dies because AUTOLOAD picks up
-# calls to DESTROY.
-#
-sub DESTROY {}
-
-
-sub read_env {
- my ($invocant) = @_;
- my $config = ref $invocant ? $invocant : $invocant->defaults;
-
- $config->{'nameservers'} = [ $ENV{'RES_NAMESERVERS'} =~ m/(\S+)/g ]
- if exists $ENV{'RES_NAMESERVERS'};
-
- $config->{'searchlist'} = [ split(' ', $ENV{'RES_SEARCHLIST'}) ]
- if exists $ENV{'RES_SEARCHLIST'};
-
- $config->{'domain'} = $ENV{'LOCALDOMAIN'}
- if exists $ENV{'LOCALDOMAIN'};
-
- if (exists $ENV{'RES_OPTIONS'}) {
- foreach ($ENV{'RES_OPTIONS'} =~ m/(\S+)/g) {
- my ($name, $val) = split(m/:/);
- $val = 1 unless defined $val;
- $config->{$name} = $val if exists $config->{$name};
- }
- }
-}
-
-#
-# $class->read_config_file($filename) or $self->read_config_file($file)
-#
-sub read_config_file {
- my ($invocant, $file) = @_;
- my $config = ref $invocant ? $invocant : $invocant->defaults;
-
-
- my @ns;
- my @searchlist;
-
- local *FILE;
-
- open(FILE, "< $file") or croak "Could not open $file: $!";
- local $/ = "\n";
- local $_;
-
- while (<FILE>) {
- s/\s*[;#].*//;
-
- # Skip ahead unless there's non-whitespace characters
- next unless m/\S/;
-
- SWITCH: {
- /^\s*domain\s+(\S+)/ && do {
- $config->{'domain'} = $1;
- last SWITCH;
- };
-
- /^\s*search\s+(.*)/ && do {
- push(@searchlist, split(' ', $1));
- last SWITCH;
- };
-
- /^\s*nameserver\s+(.*)/ && do {
- foreach my $ns (split(' ', $1)) {
- $ns = '0.0.0.0' if $ns eq '0';
-# next if $ns =~ m/:/; # skip IPv6 nameservers
- push @ns, $ns;
- }
- last SWITCH;
- };
- }
- }
- close FILE || croak "Could not close $file: $!";
-
- $config->{'nameservers'} = [ @ns ] if @ns;
- $config->{'searchlist'} = [ @searchlist ] if @searchlist;
- }
-
-
-
-
-sub print { print $_[0]->string }
-
-sub string {
- my $self = shift;
-
- my $timeout = defined $self->{'tcp_timeout'} ? $self->{'tcp_timeout'} : 'indefinite';
- my $hasINET6line= $has_inet6 ?" (IPv6 Transport is available)":" (IPv6 Transport is not available)";
- my $ignqrid=$self->{'ignqrid'} ? "\n;; ACCEPTING ALL PACKETS (IGNQRID)":"";
- return <<END;
-;; RESOLVER state:
-;; domain = $self->{domain}
-;; searchlist = @{$self->{searchlist}}
-;; nameservers = @{$self->{nameservers}}
-;; port = $self->{port}
-;; srcport = $self->{srcport}
-;; srcaddr = $self->{srcaddr}
-;; tcp_timeout = $timeout
-;; retrans = $self->{retrans} retry = $self->{retry}
-;; usevc = $self->{usevc} stayopen = $self->{stayopen} igntc = $self->{igntc}
-;; defnames = $self->{defnames} dnsrch = $self->{dnsrch}
-;; recurse = $self->{recurse} debug = $self->{debug}
-;; force_v4 = $self->{force_v4} $hasINET6line $ignqrid
-END
-
-}
-
-
-sub searchlist {
- my $self = shift;
- $self->{'searchlist'} = [ @_ ] if @_;
- return @{$self->{'searchlist'}};
-}
-
-sub nameservers {
- my $self = shift;
-
- if (@_) {
- my @a;
- foreach my $ns (@_) {
- next unless defined($ns);
- if ( _ip_is_ipv4($ns) ) {
- push @a, ($ns eq '0') ? '0.0.0.0' : $ns;
-
- } elsif ( _ip_is_ipv6($ns) ) {
- push @a, ($ns eq '0') ? '::0' : $ns;
-
- } else {
- my $defres = Net::DNS::Resolver->new;
- my @names;
-
- if ($ns !~ /\./) {
- if (defined $defres->searchlist) {
- @names = map { $ns . '.' . $_ }
- $defres->searchlist;
- } elsif (defined $defres->domain) {
- @names = ($ns . '.' . $defres->domain);
- }
- }
- else {
- @names = ($ns);
- }
-
- my $packet = $defres->search($ns);
- $self->errorstring($defres->errorstring);
- if (defined($packet)) {
- push @a, cname_addr([@names], $packet);
- }
- }
- }
-
-
- $self->{'nameservers'} = [ @a ];
- }
- my @returnval;
- foreach my $ns (@{$self->{'nameservers'}}){
- next if _ip_is_ipv6($ns) && (! $has_inet6 || $self->force_v4() );
- push @returnval, $ns;
- }
-
- return @returnval;
-}
-
-sub nameserver { &nameservers }
-
-sub cname_addr {
- my $names = shift;
- my $packet = shift;
- my @addr;
- my @names = @{$names};
-
- my $oct2 = '(?:2[0-4]\d|25[0-5]|[0-1]?\d\d|\d)';
-
- RR: foreach my $rr ($packet->answer) {
- next RR unless grep {$rr->name} @names;
-
- if ($rr->type eq 'CNAME') {
- push(@names, $rr->cname);
- } elsif ($rr->type eq 'A') {
- # Run a basic taint check.
- next RR unless $rr->address =~ m/^($oct2\.$oct2\.$oct2\.$oct2)$/o;
-
- push(@addr, $1)
- }
- }
-
-
- return @addr;
-}
-
-
-# if ($self->{"udppacketsize"} > Net::DNS::PACKETSZ()
-# then we use EDNS and $self->{"udppacketsize"}
-# should be taken as the maximum packet_data length
-sub _packetsz {
- my ($self) = @_;
-
- return $self->{"udppacketsize"} > Net::DNS::PACKETSZ() ?
- $self->{"udppacketsize"} : Net::DNS::PACKETSZ();
-}
-
-sub _reset_errorstring {
- my ($self) = @_;
-
- $self->errorstring($self->defaults->{'errorstring'});
-}
-
-
-sub search {
- my $self = shift;
- my $name = shift || '.';
-
- my $defdomain = $self->{domain} if $self->{defnames};
- my @searchlist = @{$self->{searchlist}} if $self->{dnsrch};
-
- # resolve name by trying as absolute name, then applying searchlist
- my @list = (undef, @searchlist);
- for ($name) {
- # resolve name with no dots or colons by applying searchlist (or domain)
- @list = @searchlist ? @searchlist : ($defdomain) unless m/[:.]/;
- # resolve name with trailing dot as absolute name
- @list = (undef) if m/\.$/;
- }
-
- foreach my $suffix ( @list ) {
- my $fqname = join '.', $name, ($suffix || ());
-
- print ';; search(', join(', ', $fqname, @_), ")\n" if $self->{debug};
-
- my $packet = $self->send($fqname, @_) || return undef;
-
- next unless ($packet->header->rcode eq "NOERROR"); # something
- #useful happened
- return $packet if $packet->header->ancount; # answer found
- next unless $packet->header->qdcount; # question empty?
-
- last if ($packet->question)[0]->qtype eq 'PTR'; # abort search if IP
- }
- return undef;
-}
-
-
-sub query {
- my $self = shift;
- my $name = shift || '.';
-
- # resolve name containing no dots or colons by appending domain
- my @suffix = ($self->{domain} || ()) if $name !~ m/[:.]/ and $self->{defnames};
-
- my $fqname = join '.', $name, @suffix;
-
- print ';; query(', join(', ', $fqname, @_), ")\n" if $self->{debug};
-
- my $packet = $self->send($fqname, @_) || return undef;
-
- return $packet if $packet->header->ancount; # answer found
- return undef;
-}
-
-
-sub send {
- my $self = shift;
- my $packet = $self->make_query_packet(@_);
- my $packet_data = $packet->data;
-
-
- my $ans;
-
- if ($self->{'usevc'} || length $packet_data > $self->_packetsz) {
-
- $ans = $self->send_tcp($packet, $packet_data);
-
- } else {
- $ans = $self->send_udp($packet, $packet_data);
-
- if ($ans && $ans->header->tc && !$self->{'igntc'}) {
- print ";;\n;; packet truncated: retrying using TCP\n" if $self->{'debug'};
- $ans = $self->send_tcp($packet, $packet_data);
- }
- }
-
- return $ans;
-}
-
-
-
-sub send_tcp {
- my ($self, $packet, $packet_data) = @_;
- my $lastanswer;
-
- my $srcport = $self->{'srcport'};
- my $srcaddr = $self->{'srcaddr'};
- my $dstport = $self->{'port'};
-
- unless ( $self->nameservers()) {
- $self->errorstring('no nameservers');
- print ";; ERROR: send_tcp: no nameservers\n" if $self->{'debug'};
- return;
- }
-
- $self->_reset_errorstring;
-
-
- NAMESERVER: foreach my $ns ($self->nameservers()) {
-
- print ";; attempt to send_tcp($ns:$dstport) (src port = $srcport)\n"
- if $self->{'debug'};
-
-
-
- my $sock;
- my $sock_key = "$ns:$dstport";
- my ($host,$port);
- if ($self->persistent_tcp && $self->{'sockets'}[AF_UNSPEC]{$sock_key}) {
- $sock = $self->{'sockets'}[AF_UNSPEC]{$sock_key};
- print ";; using persistent socket\n"
- if $self->{'debug'};
- unless ($sock->connected){
- print ";; persistent socket disconnected (trying to reconnect)"
- if $self->{'debug'};
- undef($sock);
- $sock= $self->_create_tcp_socket($ns);
- next NAMESERVER unless $sock;
- $self->{'sockets'}[AF_UNSPEC]{$sock_key} = $sock;
- }
-
- } else {
- $sock= $self->_create_tcp_socket($ns);
- next NAMESERVER unless $sock;
-
- $self->{'sockets'}[AF_UNSPEC]{$sock_key} = $sock if
- $self->persistent_tcp;
- }
-
-
- my $lenmsg = pack('n', length($packet_data));
- print ';; sending ', length($packet_data), " bytes\n"
- if $self->{'debug'};
-
- # note that we send the length and packet data in a single call
- # as this produces a single TCP packet rather than two. This
- # is more efficient and also makes things much nicer for sniffers.
- # (ethereal doesn't seem to reassemble DNS over TCP correctly)
-
-
- unless ($sock->send( $lenmsg . $packet_data)) {
- $self->errorstring($!);
- print ";; ERROR: send_tcp: data send failed: $!\n"
- if $self->{'debug'};
- next NAMESERVER;
- }
-
- my $sel = IO::Select->new($sock);
- my $timeout=$self->{'tcp_timeout'};
- if ($sel->can_read($timeout)) {
- my $buf = read_tcp($sock, Net::DNS::INT16SZ(), $self->{'debug'});
- next NAMESERVER unless length($buf); # Failure to get anything
- my ($len) = unpack('n', $buf);
- next NAMESERVER unless $len; # Cannot determine size
-
- unless ($sel->can_read($timeout)) {
- $self->errorstring('timeout');
- print ";; TIMEOUT\n" if $self->{'debug'};
- next;
- }
-
- $buf = read_tcp($sock, $len, $self->{'debug'});
-
- $self->answerfrom($sock->peerhost);
-
- print ';; received ', length($buf), " bytes\n"
- if $self->{'debug'};
-
- unless (length($buf) == $len) {
- $self->errorstring("expected $len bytes, " .
- 'received ' . length($buf));
- next;
- }
-
- my ($ans, $err) = Net::DNS::Packet->new(\$buf, $self->{'debug'});
- if (defined $ans) {
- $self->errorstring($ans->header->rcode);
- $ans->answerfrom($self->answerfrom);
-
- if ($ans->header->rcode ne "NOERROR" &&
- $ans->header->rcode ne "NXDOMAIN"){
- # Remove this one from the stack
- print "RCODE: ".$ans->header->rcode ."; trying next nameserver\n" if $self->{'debug'};
- $lastanswer=$ans;
- next NAMESERVER ;
-
- }
-
- }
- elsif (defined $err) {
- $self->errorstring($err);
- }
-
- return $ans;
- }
- else {
- $self->errorstring('timeout');
- next;
- }
- }
-
- if ($lastanswer){
- $self->errorstring($lastanswer->header->rcode );
- return $lastanswer;
-
- }
-
- return;
-}
-
-
-
-sub send_udp {
- my ($self, $packet, $packet_data) = @_;
- my $retrans = $self->{'retrans'};
- my $timeout = $retrans;
-
- my $lastanswer;
-
- my $stop_time = time + $self->{'udp_timeout'} if $self->{'udp_timeout'};
-
- $self->_reset_errorstring;
-
- my @ns;
- my $dstport = $self->{'port'};
- my $srcport = $self->{'srcport'};
- my $srcaddr = $self->{'srcaddr'};
-
- my @sock;
-
-
- if ($self->persistent_udp){
- if ($has_inet6){
- if ( defined ($self->{'sockets'}[AF_INET6()]{'UDP'})) {
- $sock[AF_INET6()] = $self->{'sockets'}[AF_INET6()]{'UDP'};
- print ";; using persistent AF_INET6() family type socket\n"
- if $self->{'debug'};
- }
- }
- if ( defined ($self->{'sockets'}[AF_INET]{'UDP'})) {
- $sock[AF_INET] = $self->{'sockets'}[AF_INET]{'UDP'};
- print ";; using persistent AF_INET() family type socket\n"
- if $self->{'debug'};
- }
- }
-
- if ($has_inet6 && ! $self->force_v4() && !defined( $sock[AF_INET6()] )){
-
-
- # '::' Otherwise the INET6 socket will fail.
-
- my $srcaddr6 = $srcaddr eq '0.0.0.0' ? '::' : $srcaddr;
-
- print ";; Trying to set up a AF_INET6() family type UDP socket with srcaddr: $srcaddr ... "
- if $self->{'debug'};
-
-
- # IO::Socket carps on errors if Perl's -w flag is turned on.
- # Uncomment the next two lines and the line following the "new"
- # call to turn off these messages.
-
- #my $old_wflag = $^W;
- #$^W = 0;
-
- $sock[AF_INET6()] = IO::Socket::INET6->new(
- LocalAddr => $srcaddr6,
- LocalPort => ($srcport || undef),
- Proto => 'udp',
- );
-
-
-
-
- print (defined($sock[AF_INET6()])?"done\n":"failed\n") if $has_inet6 && $self->debug();
-
- }
-
- # Always set up an AF_INET socket.
- # It will be used if the address familly of for the endpoint is V4.
-
- if (!defined( $sock[AF_INET]))
-
- {
- print ";; setting up an AF_INET() family type UDP socket\n"
- if $self->{'debug'};
-
- #my $old_wflag = $^W;
- #$^W = 0;
-
- $sock[AF_INET] = IO::Socket::INET->new(
- LocalAddr => $srcaddr,
- LocalPort => ($srcport || undef),
- Proto => 'udp',
- ) ;
-
- #$^W = $old_wflag;
- }
-
-
-
- unless (defined $sock[AF_INET] || ($has_inet6 && defined $sock[AF_INET6()])) {
-
- $self->errorstring("could not get socket"); #'
- return;
- }
-
- $self->{'sockets'}[AF_INET]{'UDP'} = $sock[AF_INET] if ($self->persistent_udp) && defined( $sock[AF_INET] );
- $self->{'sockets'}[AF_INET6()]{'UDP'} = $sock[AF_INET6()] if $has_inet6 && ($self->persistent_udp) && defined( $sock[AF_INET6()]) && ! $self->force_v4();
-
- # Constructing an array of arrays that contain 3 elements: The
- # nameserver IP address, its sockaddr and the sockfamily for
- # which the sockaddr structure is constructed.
-
- my $nmbrnsfailed=0;
- NSADDRESS: foreach my $ns_address ($self->nameservers()){
- # The logic below determines the $dst_sockaddr.
- # If getaddrinfo is available that is used for both INET4 and INET6
- # If getaddrinfo is not avialable (Socket6 failed to load) we revert
- # to the 'classic mechanism
- if ($has_inet6 && ! $self->force_v4() ){
- # we can use getaddrinfo
- no strict 'subs'; # Because of the eval statement in the BEGIN
- # AI_NUMERICHOST is not available at compile time.
- # The AI_NUMERICHOST surpresses lookups.
-
- my $old_wflag = $^W; #circumvent perl -w warnings about 'udp'
- $^W = 0;
-
-
-
- my @res = getaddrinfo($ns_address, $dstport, AF_UNSPEC, SOCK_DGRAM,
- 0, AI_NUMERICHOST);
-
- $^W=$old_wflag ;
-
-
- use strict 'subs';
-
- my ($sockfamily, $socktype_tmp,
- $proto_tmp, $dst_sockaddr, $canonname_tmp) = @res;
-
- if (scalar(@res) < 5) {
- die ("can't resolve \"$ns_address\" to address");
- }
-
- push @ns,[$ns_address,$dst_sockaddr,$sockfamily];
-
- }else{
- next NSADDRESS unless( _ip_is_ipv4($ns_address));
- my $dst_sockaddr = sockaddr_in($dstport, inet_aton($ns_address));
- push @ns, [$ns_address,$dst_sockaddr,AF_INET];
- }
-
- }
-
- unless (@ns) {
- print "No nameservers" if $self->debug();
- $self->errorstring('no nameservers');
- return;
- }
-
- my $sel = IO::Select->new() ;
- # We allready tested that one of the two socket exists
-
- $sel->add($sock[AF_INET]) if defined ($sock[AF_INET]);
- $sel->add($sock[AF_INET6()]) if $has_inet6 && defined ($sock[AF_INET6()]) && ! $self->force_v4();
-
-
- # Perform each round of retries.
- for (my $i = 0;
- $i < $self->{'retry'};
- ++$i, $retrans *= 2, $timeout = int($retrans / (@ns || 1))) {
-
- $timeout = 1 if ($timeout < 1);
-
- # Try each nameserver.
- NAMESERVER: foreach my $ns (@ns) {
- next if defined $ns->[3];
- if ($stop_time) {
- my $now = time;
- if ($stop_time < $now) {
- $self->errorstring('query timed out');
- return;
- }
- if ($timeout > 1 && $timeout > ($stop_time-$now)) {
- $timeout = $stop_time-$now;
- }
- }
- my $nsname = $ns->[0];
- my $nsaddr = $ns->[1];
- my $nssockfamily = $ns->[2];
-
- # If we do not have a socket for the transport
- # we are supposed to reach the namserver on we
- # should skip it.
- unless (defined ($sock[ $nssockfamily ])){
- print "Send error: cannot reach $nsname (".
-
- ( ($has_inet6 && $nssockfamily == AF_INET6()) ? "IPv6" : "" ).
- ( ($nssockfamily == AF_INET) ? "IPv4" : "" ).
- ") not available"
- if $self->debug();
-
-
- $self->errorstring("Send error: cannot reach $nsname (" .
- ( ($has_inet6 && $nssockfamily == AF_INET6()) ? "IPv6" : "" ).
- ( ($nssockfamily == AF_INET) ? "IPv4" : "" ).
- ") not available"
-
-);
- next NAMESERVER ;
- }
-
- print ";; send_udp($nsname:$dstport)\n"
- if $self->{'debug'};
-
- unless ($sock[$nssockfamily]->send($packet_data, 0, $nsaddr)) {
- print ";; send error: $!\n" if $self->{'debug'};
- $self->errorstring("Send error: $!");
- $nmbrnsfailed++;
- $ns->[3]="Send error".$self->errorstring();
- next;
- }
-
- # See ticket 11931 but this works not quite yet
- my $oldpacket_timeout=time+$timeout;
- until ( $oldpacket_timeout && ($oldpacket_timeout < time())) {
- my @ready = $sel->can_read($timeout);
- SELECTOR: foreach my $ready (@ready) {
- my $buf = '';
-
- if ($ready->recv($buf, $self->_packetsz)) {
-
- $self->answerfrom($ready->peerhost);
-
- print ';; answer from ',
- $ready->peerhost, ':',
- $ready->peerport, ' : ',
- length($buf), " bytes\n"
- if $self->{'debug'};
-
- my ($ans, $err) = Net::DNS::Packet->new(\$buf, $self->{'debug'});
-
- if (defined $ans) {
- next SELECTOR unless ( $ans->header->qr || $self->{'ignqrid'});
- next SELECTOR unless ( ($ans->header->id == $packet->header->id) || $self->{'ignqrid'} );
- $self->errorstring($ans->header->rcode);
- $ans->answerfrom($self->answerfrom);
- if ($ans->header->rcode ne "NOERROR" &&
- $ans->header->rcode ne "NXDOMAIN"){
- # Remove this one from the stack
-
- print "RCODE: ".$ans->header->rcode ."; trying next nameserver\n" if $self->{'debug'};
- $nmbrnsfailed++;
- $ns->[3]="RCODE: ".$ans->header->rcode();
- $lastanswer=$ans;
- next NAMESERVER ;
-
- }
- } elsif (defined $err) {
- $self->errorstring($err);
- }
- return $ans;
- } else {
- $self->errorstring($!);
- print ';; recv ERROR(',
- $ready->peerhost, ':',
- $ready->peerport, '): ',
- $self->errorstring, "\n"
- if $self->{'debug'};
- $ns->[3]="Recv error ".$self->errorstring();
- $nmbrnsfailed++;
- # We want to remain in the SELECTOR LOOP...
- # unless there are no more nameservers
- return unless ($nmbrnsfailed < @ns);
- print ';; Number of failed nameservers: $nmbrnsfailed out of '.scalar @ns."\n" if $self->{'debug'};
-
- }
- } #SELECTOR LOOP
- } # until stop_time loop
- } #NAMESERVER LOOP
-
- }
-
- if ($lastanswer){
- $self->errorstring($lastanswer->header->rcode );
- return $lastanswer;
-
- }
- if ($sel->handles) {
- # If there are valid hanndles than we have either a timeout or
- # a send error.
- $self->errorstring('query timed out') unless ($self->errorstring =~ /Send error:/);
- }
- else {
- if ($nmbrnsfailed < @ns){
- $self->errorstring('Unexpected Error') ;
- }else{
- $self->errorstring('all nameservers failed');
- }
- }
- return;
-}
-
-
-sub bgsend {
- my $self = shift;
-
- unless ($self->nameservers()) {
- $self->errorstring('no nameservers');
- return;
- }
-
- $self->_reset_errorstring;
-
- my $packet = $self->make_query_packet(@_);
- my $packet_data = $packet->data;
-
- my $srcaddr = $self->{'srcaddr'};
- my $srcport = $self->{'srcport'};
-
-
- my (@res, $sockfamily, $dst_sockaddr);
- my $ns_address = ($self->nameservers())[0];
- my $dstport = $self->{'port'};
-
-
- # The logic below determines ther $dst_sockaddr.
- # If getaddrinfo is available that is used for both INET4 and INET6
- # If getaddrinfo is not avialable (Socket6 failed to load) we revert
- # to the 'classic mechanism
- if ($has_inet6 && ! $self->force_v4()){
-
- my ( $socktype_tmp, $proto_tmp, $canonname_tmp);
-
- no strict 'subs'; # Because of the eval statement in the BEGIN
- # AI_NUMERICHOST is not available at compile time.
-
- # The AI_NUMERICHOST surpresses lookups.
- my @res = getaddrinfo($ns_address, $dstport, AF_UNSPEC, SOCK_DGRAM,
- 0 , AI_NUMERICHOST);
-
- use strict 'subs';
-
- ($sockfamily, $socktype_tmp,
- $proto_tmp, $dst_sockaddr, $canonname_tmp) = @res;
-
- if (scalar(@res) < 5) {
- die ("can't resolve \"$ns_address\" to address (it could have been an IP address)");
- }
-
- }else{
- $sockfamily=AF_INET;
-
- if (! _ip_is_ipv4($ns_address)){
- $self->errorstring("bgsend(ipv4 only):$ns_address does not seem to be a valid IPv4 address");
- return;
- }
-
- $dst_sockaddr = sockaddr_in($dstport, inet_aton($ns_address));
- }
- my @socket;
-
- if ($sockfamily == AF_INET) {
- $socket[$sockfamily] = IO::Socket::INET->new(
- Proto => 'udp',
- Type => SOCK_DGRAM,
- LocalAddr => $srcaddr,
- LocalPort => ($srcport || undef),
- );
- } elsif ($has_inet6 && $sockfamily == AF_INET6() ) {
- # Otherwise the INET6 socket will just fail
- my $srcaddr6 = $srcaddr eq "0.0.0.0" ? '::' : $srcaddr;
- $socket[$sockfamily] = IO::Socket::INET6->new(
- Proto => 'udp',
- Type => SOCK_DGRAM,
- LocalAddr => $srcaddr6,
- LocalPort => ($srcport || undef),
- );
- } else {
- die ref($self)." bgsend:Unsoported Socket Family: $sockfamily";
- }
-
- unless (scalar(@socket)) {
- $self->errorstring("could not get socket"); #'
- return;
- }
-
- print ";; bgsend($ns_address : $dstport)\n" if $self->{'debug'} ;
-
- foreach my $socket (@socket){
- next if !defined $socket;
-
- unless ($socket->send($packet_data,0,$dst_sockaddr)){
- my $err = $!;
- print ";; send ERROR($ns_address): $err\n" if $self->{'debug'};
-
- $self->errorstring("Send: ".$err);
- return;
- }
- return $socket;
- }
- $self->errorstring("Could not find a socket to send on");
- return;
-
-}
-
-sub bgread {
- my ($self, $sock) = @_;
-
- my $buf = '';
-
- my $peeraddr = $sock->recv($buf, $self->_packetsz);
-
- if ($peeraddr) {
- print ';; answer from ', $sock->peerhost, ':',
- $sock->peerport, ' : ', length($buf), " bytes\n"
- if $self->{'debug'};
-
- my ($ans, $err) = Net::DNS::Packet->new(\$buf, $self->{'debug'});
-
- if (defined $ans) {
- $self->errorstring($ans->header->rcode);
- $ans->answerfrom($sock->peerhost);
- } elsif (defined $err) {
- $self->errorstring($err);
- }
-
- return $ans;
- } else {
- $self->errorstring($!);
- return;
- }
-}
-
-sub bgisready {
- my $self = shift;
- my $sel = IO::Select->new(@_);
- my @ready = $sel->can_read(0.0);
- return @ready > 0;
-}
-
-sub make_query_packet {
- my $self = shift;
- my $packet;
-
- if (ref($_[0]) and $_[0]->isa('Net::DNS::Packet')) {
- $packet = shift;
- } else {
- $packet = Net::DNS::Packet->new(@_);
- }
-
- if ($packet->header->opcode eq 'QUERY') {
- $packet->header->rd($self->{'recurse'});
- }
-
- if ($self->{'dnssec'}) {
- # RFC 3225
- print ";; Adding EDNS extention with UDP packetsize $self->{'udppacketsize'} and DNS OK bit set\n"
- if $self->{'debug'};
-
- my $optrr = Net::DNS::RR->new(
- Type => 'OPT',
- Name => '',
- Class => $self->{'udppacketsize'}, # Decimal UDPpayload
- ednsflags => 0x8000, # first bit set see RFC 3225
- );
-
-
- $packet->push('additional', $optrr) unless defined $packet->{'optadded'} ;
- $packet->{'optadded'}=1;
- } elsif ($self->{'udppacketsize'} > Net::DNS::PACKETSZ()) {
- print ";; Adding EDNS extention with UDP packetsize $self->{'udppacketsize'}.\n" if $self->{'debug'};
- # RFC 3225
- my $optrr = Net::DNS::RR->new(
- Type => 'OPT',
- Name => '',
- Class => $self->{'udppacketsize'}, # Decimal UDPpayload
- TTL => 0x0000 # RCODE 32bit Hex
- );
-
- $packet->push('additional', $optrr) unless defined $packet->{'optadded'} ;
- $packet->{'optadded'}=1;
- }
-
-
- if ($self->{'tsig_rr'}) {
- if (!grep { $_->type eq 'TSIG' } $packet->additional) {
- $packet->push('additional', $self->{'tsig_rr'});
- }
- }
-
- return $packet;
-}
-
-sub axfr {
- my $self = shift;
- my @zone;
-
- if ($self->axfr_start(@_)) {
- my ($rr, $err);
- while (($rr, $err) = $self->axfr_next, $rr && !$err) {
- push @zone, $rr;
- }
- @zone = () if $err;
- }
-
- return @zone;
-}
-
-sub axfr_old {
- croak "Use of Net::DNS::Resolver::axfr_old() is deprecated, use axfr() or axfr_start().";
-}
-
-
-sub axfr_start {
- my $self = shift;
- my ($dname, $class) = @_;
- $dname ||= $self->{'searchlist'}->[0];
- $class ||= 'IN';
- my $timeout = $self->{'tcp_timeout'};
-
- unless ($dname) {
- print ";; ERROR: axfr: no zone specified\n" if $self->{'debug'};
- $self->errorstring('no zone');
- return;
- }
-
-
- print ";; axfr_start($dname, $class)\n" if $self->{'debug'};
-
- unless ($self->nameservers()) {
- $self->errorstring('no nameservers');
- print ";; ERROR: no nameservers\n" if $self->{'debug'};
- return;
- }
-
- my $packet = $self->make_query_packet($dname, 'AXFR', $class);
- my $packet_data = $packet->data;
-
- my $ns = ($self->nameservers())[0];
-
-
- my $srcport = $self->{'srcport'};
- my $srcaddr = $self->{'srcaddr'};
- my $dstport = $self->{'port'};
-
- print ";; axfr_start nameserver = $ns\n" if $self->{'debug'};
- print ";; axfr_start srcport: $srcport, srcaddr: $srcaddr, dstport: $dstport\n" if $self->{'debug'};
-
-
- my $sock;
- my $sock_key = "$ns:$self->{'port'}";
-
-
- if ($self->persistent_tcp && $self->{'axfr_sockets'}[AF_UNSPEC]{$sock_key}) {
- $sock = $self->{'axfr_sockets'}[AF_UNSPEC]{$sock_key};
- print ";; using persistent socket\n"
- if $self->{'debug'};
- } else {
- $sock=$self->_create_tcp_socket($ns);
-
- return unless ($sock); # all error messages
- # are set by _create_tcp_socket
-
-
- $self->{'axfr_sockets'}[AF_UNSPEC]{$sock_key} = $sock if
- $self->persistent_tcp;
- }
-
- my $lenmsg = pack('n', length($packet_data));
-
- unless ($sock->send($lenmsg)) {
- $self->errorstring($!);
- return;
- }
-
- unless ($sock->send($packet_data)) {
- $self->errorstring($!);
- return;
- }
-
- my $sel = IO::Select->new($sock);
-
- $self->{'axfr_sel'} = $sel;
- $self->{'axfr_rr'} = [];
- $self->{'axfr_soa_count'} = 0;
-
- return $sock;
-}
-
-
-sub axfr_next {
- my $self = shift;
- my $err = '';
-
- unless (@{$self->{'axfr_rr'}}) {
- unless ($self->{'axfr_sel'}) {
- my $err = 'no zone transfer in progress';
-
- print ";; $err\n" if $self->{'debug'};
- $self->errorstring($err);
-
- return wantarray ? (undef, $err) : undef;
- }
-
- my $sel = $self->{'axfr_sel'};
- my $timeout = $self->{'tcp_timeout'};
-
- #--------------------------------------------------------------
- # Read the length of the response packet.
- #--------------------------------------------------------------
-
- my @ready = $sel->can_read($timeout);
- unless (@ready) {
- $err = 'timeout';
- $self->errorstring($err);
- return wantarray ? (undef, $err) : undef;
- }
-
- my $buf = read_tcp($ready[0], Net::DNS::INT16SZ(), $self->{'debug'});
- unless (length $buf) {
- $err = 'truncated zone transfer';
- $self->errorstring($err);
- return wantarray ? (undef, $err) : undef;
- }
-
- my ($len) = unpack('n', $buf);
- unless ($len) {
- $err = 'truncated zone transfer';
- $self->errorstring($err);
- return wantarray ? (undef, $err) : undef;
- }
-
- #--------------------------------------------------------------
- # Read the response packet.
- #--------------------------------------------------------------
-
- @ready = $sel->can_read($timeout);
- unless (@ready) {
- $err = 'timeout';
- $self->errorstring($err);
- return wantarray ? (undef, $err) : undef;
- }
-
- $buf = read_tcp($ready[0], $len, $self->{'debug'});
-
- print ';; received ', length($buf), " bytes\n"
- if $self->{'debug'};
-
- unless (length($buf) == $len) {
- $err = "expected $len bytes, received " . length($buf);
- $self->errorstring($err);
- print ";; $err\n" if $self->{'debug'};
- return wantarray ? (undef, $err) : undef;
- }
-
- my $ans;
- ($ans, $err) = Net::DNS::Packet->new(\$buf, $self->{'debug'});
-
- if ($ans) {
- if ($ans->header->rcode ne 'NOERROR') {
- $self->errorstring('Response code from server: ' . $ans->header->rcode);
- print ';; Response code from server: ' . $ans->header->rcode . "\n" if $self->{'debug'};
- return wantarray ? (undef, $err) : undef;
- }
- if ($ans->header->ancount < 1) {
- $err = 'truncated zone transfer';
- $self->errorstring($err);
- print ";; $err\n" if $self->{'debug'};
- return wantarray ? (undef, $err) : undef;
- }
- }
- else {
- $err ||= 'unknown error during packet parsing';
- $self->errorstring($err);
- print ";; $err\n" if $self->{'debug'};
- return wantarray ? (undef, $err) : undef;
- }
-
- foreach my $rr ($ans->answer) {
- if ($rr->type eq 'SOA') {
- if (++$self->{'axfr_soa_count'} < 2) {
- push @{$self->{'axfr_rr'}}, $rr;
- }
- }
- else {
- push @{$self->{'axfr_rr'}}, $rr;
- }
- }
-
- if ($self->{'axfr_soa_count'} >= 2) {
- $self->{'axfr_sel'} = undef;
- # we need to mark the transfer as over if the responce was in
- # many answers. Otherwise, the user will call axfr_next again
- # and that will cause a 'no transfer in progress' error.
- push(@{$self->{'axfr_rr'}}, undef);
- }
- }
-
- my $rr = shift @{$self->{'axfr_rr'}};
-
- return wantarray ? ($rr, undef) : $rr;
-}
-
-
-
-
-sub dnssec {
- my ($self, $new_val) = @_;
- if (defined $new_val) {
- $self->{"dnssec"} = $new_val;
- # Setting the udppacket size to some higher default
- $self->udppacketsize(2048) if $new_val;
- }
-
- Carp::carp ("You called the Net::DNS::Resolver::dnssec() method but do not have Net::DNS::SEC installed") if $self->{"dnssec"} && ! $Net::DNS::DNSSEC;
- return $self->{"dnssec"};
-};
-
-
-
-sub tsig {
- my $self = shift;
-
- if (@_ == 1) {
- if ($_[0] && ref($_[0])) {
- $self->{'tsig_rr'} = $_[0];
- }
- else {
- $self->{'tsig_rr'} = undef;
- }
- }
- elsif (@_ == 2) {
- my ($key_name, $key) = @_;
- $self->{'tsig_rr'} = Net::DNS::RR->new("$key_name TSIG $key");
- }
-
- return $self->{'tsig_rr'};
-}
-
-#
-# Usage: $data = read_tcp($socket, $nbytes, $debug);
-#
-sub read_tcp {
- my ($sock, $nbytes, $debug) = @_;
- my $buf = '';
-
- while (length($buf) < $nbytes) {
- my $nread = $nbytes - length($buf);
- my $read_buf = '';
-
- print ";; read_tcp: expecting $nread bytes\n" if $debug;
-
- # During some of my tests recv() returned undef even
- # though there wasn't an error. Checking for the amount
- # of data read appears to work around that problem.
-
- unless ($sock->recv($read_buf, $nread)) {
- if (length($read_buf) < 1) {
- my $errstr = $!;
-
- print ";; ERROR: read_tcp: recv failed: $!\n"
- if $debug;
-
- if ($errstr eq 'Resource temporarily unavailable') {
- warn "ERROR: read_tcp: recv failed: $errstr\n";
- warn "ERROR: try setting \$res->timeout(undef)\n";
- }
-
- last;
- }
- }
-
- print ';; read_tcp: received ', length($read_buf), " bytes\n"
- if $debug;
-
- last unless length($read_buf);
- $buf .= $read_buf;
- }
-
- return $buf;
-}
-
-
-
-sub _create_tcp_socket {
- my $self=shift;
- my $ns=shift;
- my $sock;
-
- my $srcport = $self->{'srcport'};
- my $srcaddr = $self->{'srcaddr'};
- my $dstport = $self->{'port'};
-
- my $timeout = $self->{'tcp_timeout'};
- # IO::Socket carps on errors if Perl's -w flag is
- # turned on. Uncomment the next two lines and the
- # line following the "new" call to turn off these
- # messages.
-
- #my $old_wflag = $^W;
- #$^W = 0;
-
- if ($has_inet6 && ! $self->force_v4() && _ip_is_ipv6($ns) ){
- # XXX IO::Socket::INET6 fails in a cryptic way upon send()
- # on AIX5L if "0" is passed in as LocalAddr
- # $srcaddr="0" if $srcaddr eq "0.0.0.0"; # Otherwise the INET6 socket will just fail
-
- my $srcaddr6 = $srcaddr eq '0.0.0.0' ? '::' : $srcaddr;
-
- $sock =
- IO::Socket::INET6->new(
- PeerPort => $dstport,
- PeerAddr => $ns,
- LocalAddr => $srcaddr6,
- LocalPort => ($srcport || undef),
- Proto => 'tcp',
- Timeout => $timeout,
- );
-
- unless($sock){
- $self->errorstring('connection failed(IPv6 socket failure)');
- print ";; ERROR: send_tcp: IPv6 connection to $ns".
- "failed: $!\n" if $self->{'debug'};
- return();
- }
- }
-
- # At this point we have sucessfully obtained an
- # INET6 socket to an IPv6 nameserver, or we are
- # running forced v4, or we do not have v6 at all.
- # Try v4.
-
- unless($sock){
- if (_ip_is_ipv6($ns)){
- $self->errorstring(
- 'connection failed (trying IPv6 nameserver without having IPv6)');
- print
- ';; ERROR: send_tcp: You are trying to connect to '.
- $ns . " but you do not have IPv6 available\n"
- if $self->{'debug'};
- return();
- }
-
-
- $sock = IO::Socket::INET->new(
- PeerAddr => $ns,
- PeerPort => $dstport,
- LocalAddr => $srcaddr,
- LocalPort => ($srcport || undef),
- Proto => 'tcp',
- Timeout => $timeout
- )
- }
-
- #$^W = $old_wflag;
-
- unless ($sock) {
- $self->errorstring('connection failed');
- print ';; ERROR: send_tcp: connection ',
- "failed: $!\n" if $self->{'debug'};
- return();
- }
-
- return $sock;
-}
-
-
-# Lightweight versions of subroutines from Net::IP module, recoded to fix rt#28198
-
-sub _ip_is_ipv4 {
- my @field = split /\./, shift;
-
- return 0 if @field > 4; # too many fields
- return 0 if @field == 0; # no fields at all
-
- foreach ( @field ) {
- return 0 unless /./; # reject if empty
- return 0 if /[^0-9]/; # reject non-digit
- return 0 if $_ > 255; # reject bad value
- }
-
-
- return 1;
-}
-
-
-sub _ip_is_ipv6 {
-
- for ( shift ) {
- my @field = split /:/; # split into fields
- return 0 if (@field < 3) or (@field > 8);
-
- return 0 if /::.*::/; # reject multiple ::
-
- if ( /\./ ) { # IPv6:IPv4
- return 0 unless _ip_is_ipv4(pop @field);
- }
-
- foreach ( @field ) {
- next unless /./; # skip ::
- return 0 if /[^0-9a-f]/i; # reject non-hexdigit
- return 0 if length $_ > 4; # reject bad value
- }
- }
- return 1;
-}
-
-
-
-sub AUTOLOAD {
- my ($self) = @_;
-
- my $name = $AUTOLOAD;
- $name =~ s/.*://;
-
- Carp::croak "$name: no such method" unless exists $self->{$name};
-
- no strict q/refs/;
-
-
- *{$AUTOLOAD} = sub {
- my ($self, $new_val) = @_;
-
- if (defined $new_val) {
- $self->{"$name"} = $new_val;
- }
-
- return $self->{"$name"};
- };
-
-
- goto &{$AUTOLOAD};
-}
-
-1;
-
-__END__
-
-=head1 NAME
-
-Net::DNS::Resolver::Base - Common Resolver Class
-
-=head1 SYNOPSIS
-
- use base qw/Net::DNS::Resolver::Base/;
-
-=head1 DESCRIPTION
-
-This class is the common base class for the different platform
-sub-classes of L<Net::DNS::Resolver|Net::DNS::Resolver>.
-
-No user serviceable parts inside, see L<Net::DNS::Resolver|Net::DNS::Resolver>
-for all your resolving needs.
-
-=head1 COPYRIGHT
-
-Copyright (c) 1997-2002 Michael Fuhr.
-
-Portions Copyright (c) 2002-2004 Chris Reinhardt.
-Portions Copyright (c) 2005 Olaf Kolkman <olaf@net-dns.org>
-Portions Copyright (c) 2006 Dick Franks.
-
-All rights reserved. This program is free software; you may redistribute
-it and/or modify it under the same terms as Perl itself.
-
-=head1 SEE ALSO
-
-L<perl(1)>, L<Net::DNS>, L<Net::DNS::Resolver>
-
-=cut
-
-
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/Resolver/Cygwin.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/Resolver/Cygwin.pm
deleted file mode 100644
index bae2d311d0c..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/Resolver/Cygwin.pm
+++ /dev/null
@@ -1,180 +0,0 @@
-package Net::DNS::Resolver::Cygwin;
-#
-# $Id: Cygwin.pm 696 2007-12-28 13:46:20Z olaf $
-#
-
-use strict;
-use vars qw(@ISA $VERSION);
-
-use Net::DNS::Resolver::Base ();
-
-@ISA = qw(Net::DNS::Resolver::Base);
-$VERSION = (qw$LastChangedRevision: 696 $)[1];
-
-sub getregkey {
- my $key = $_[0] . $_[1];
- my $value = '';
-
- local *LM;
-
- if (open(LM, "<$key")) {
- $value = <LM>;
- $value =~ s/\0+$//;
- close(LM);
- }
-
- return $value;
-}
-
-sub init {
- my ($class) = @_;
- my $defaults = $class->defaults;
-
- local *LM;
-
- my $root = '/proc/registry/HKEY_LOCAL_MACHINE/SYSTEM/CurrentControlSet/Services/Tcpip/Parameters/';
-
- unless (-d $root) {
- # Doesn't exist, maybe we are on 95/98/Me?
- $root = '/proc/registry/HKEY_LOCAL_MACHINE/SYSTEM/CurrentControlSet/Services/VxD/MSTCP/';
- -d $root || Carp::croak "can't read registry: $!";
- }
-
- # Best effort to find a useful domain name for the current host
- # if domain ends up blank, we're probably (?) not connected anywhere
- # a DNS server is interesting either...
- my $domain = getregkey($root, 'Domain') || getregkey($root, 'DhcpDomain') || '';
-
- # If nothing else, the searchlist should probably contain our own domain
- # also see below for domain name devolution if so configured
- # (also remove any duplicates later)
- my $searchlist = "$domain ";
- $searchlist .= getregkey($root, 'SearchList');
-
- # This is (probably) adequate on NT4
- my $nt4nameservers = getregkey($root, 'NameServer') || getregkey($root, 'DhcpNameServer');
- my $nameservers = "";
- #
- # but on W2K/XP the registry layout is more advanced due to dynamically
- # appearing connections. So we attempt to handle them, too...
- # opt to silently fail if something isn't ok (maybe we're on NT4)
- # If this doesn't fail override any NT4 style result we found, as it
- # may be there but is not valid.
- # drop any duplicates later
- my $dnsadapters = $root . "DNSRegisteredAdapters/";
- if (opendir(LM, $dnsadapters)) {
- my @adapters = grep($_ ne "." && $_ ne "..", readdir(LM));
- closedir(LM);
- foreach my $adapter (@adapters) {
- my $regadapter = $dnsadapters . $adapter . '/';
- if (-e $regadapter) {
- my $ns = getregkey($regadapter, 'DNSServerAddresses') || '';
- while (length($ns) >= 4) {
- my $addr = join('.', unpack("C4", substr($ns,0,4,"")));
- $nameservers .= " $addr";
- }
- }
- }
- }
-
- my $interfaces = $root . "Interfaces/";
- if (opendir(LM, $interfaces)) {
- my @ifacelist = grep($_ ne "." && $_ ne "..", readdir(LM));
- closedir(LM);
- foreach my $iface (@ifacelist) {
- my $regiface = $interfaces . $iface . '/';
- if (opendir(LM, $regiface)) {
- closedir(LM);
-
- my $ns;
- my $ip;
- $ip = getregkey($regiface, "DhcpIPAddress") || getregkey($regiface, "IPAddress");
- $ns = getregkey($regiface, "NameServer") ||
- getregkey($regiface, "DhcpNameServer") || '' unless !$ip || ($ip =~ /0\.0\.0\.0/);
-
- $nameservers .= " $ns" if $ns;
- }
- }
- }
-
- if (!$nameservers) {
- $nameservers = $nt4nameservers;
- }
-
- if ($domain) {
- $defaults->{'domain'} = $domain;
- }
-
- my $usedevolution = getregkey($root, 'UseDomainNameDevolution');
- if ($searchlist) {
- # fix devolution if configured, and simultaneously make sure no dups (but keep the order)
- my @a;
- my %h;
- foreach my $entry (split(m/[\s,]+/, $searchlist)) {
- push(@a, $entry) unless $h{$entry};
- $h{$entry} = 1;
- if ($usedevolution) {
- # as long there's more than two pieces, cut
- while ($entry =~ m#\..+\.#) {
- $entry =~ s#^[^\.]+\.(.+)$#$1#;
- push(@a, $entry) unless $h{$entry};
- $h{$entry} = 1;
- }
- }
- }
- $defaults->{'searchlist'} = \@a;
- }
-
- if ($nameservers) {
- # just in case dups were introduced...
- my @a;
- my %h;
- foreach my $ns (split(m/[\s,]+/, $nameservers)) {
- push @a, $ns unless (!$ns || $h{$ns});
- $h{$ns} = 1;
- }
- $defaults->{'nameservers'} = [map { m/(.*)/ } @a];
- }
-
- $class->read_env;
-
- if (!$defaults->{'domain'} && @{$defaults->{'searchlist'}}) {
- $defaults->{'domain'} = $defaults->{'searchlist'}[0];
- } elsif (!@{$defaults->{'searchlist'}} && $defaults->{'domain'}) {
- $defaults->{'searchlist'} = [ $defaults->{'domain'} ];
- }
-}
-
-1;
-__END__
-
-
-=head1 NAME
-
-Net::DNS::Resolver::Cygwin - Cygwin Resolver Class
-
-=head1 SYNOPSIS
-
- use Net::DNS::Resolver;
-
-=head1 DESCRIPTION
-
-This class implements the cygwin specific portions of C<Net::DNS::Resolver>.
-
-No user serviceable parts inside, see L<Net::DNS::Resolver|Net::DNS::Resolver>
-for all your resolving needs.
-
-=head1 COPYRIGHT
-
-Copyright (c) 1997-2002 Michael Fuhr.
-
-Portions Copyright (c) 2002-2004 Chris Reinhardt.
-
-All rights reserved. This program is free software; you may redistribute
-it and/or modify it under the same terms as Perl itself.
-
-=head1 SEE ALSO
-
-L<perl(1)>, L<Net::DNS>, L<Net::DNS::Resolver>
-
-=cut
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/Resolver/Recurse.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/Resolver/Recurse.pm
deleted file mode 100644
index 24e834b9c0a..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/Resolver/Recurse.pm
+++ /dev/null
@@ -1,485 +0,0 @@
-package Net::DNS::Resolver::Recurse;
-#
-# $Id: Recurse.pm 591 2006-05-22 21:32:38Z olaf $
-#
-use strict;
-use Net::DNS::Resolver;
-
-use vars qw($VERSION @ISA);
-
-$VERSION = (qw$LastChangedRevision: 591 $)[1];
-@ISA = qw(Net::DNS::Resolver);
-
-sub hints {
- my $self = shift;
- my @hints = @_;
- print ";; hints(@hints)\n" if $self->{'debug'};
- if (!@hints && $self->nameservers) {
- $self->hints($self->nameservers);
- } else {
- $self->nameservers(@hints);
- }
-
- print ";; verifying (root) zone...\n" if $self->{'debug'};
- # bind always asks one of the hint servers
- # for who it thinks is authoritative for
- # the (root) zone as a sanity check.
- # Nice idea.
-
- $self->recurse(1);
- my $packet=$self->query(".", "NS", "IN");
- $self->recurse(0);
- my %hints = ();
- if ($packet) {
- if (my @ans = $packet->answer) {
- foreach my $rr (@ans) {
- if ($rr->name =~ /^\.?$/ and
- $rr->type eq "NS") {
- # Found root authority
- my $server = lc $rr->rdatastr;
- $server =~ s/\.$//;
- print ";; FOUND HINT: $server\n" if $self->{'debug'};
- $hints{$server} = [];
- }
- }
- foreach my $rr ($packet->additional) {
- print ";; ADDITIONAL: ",$rr->string,"\n" if $self->{'debug'};
- if (my $server = lc $rr->name){
- if ( $rr->type eq "A") {
- #print ";; ADDITIONAL HELP: $server -> [".$rr->rdatastr."]\n" if $self->{'debug'};
- if ($hints{$server}) {
- print ";; STORING IP: $server IN A ",$rr->rdatastr,"\n" if $self->{'debug'};
- push @{ $hints{$server} }, $rr->rdatastr;
- }
- }
- if ( $rr->type eq "AAAA") {
- #print ";; ADDITIONAL HELP: $server -> [".$rr->rdatastr."]\n" if $self->{'debug'};
- if ($hints{$server}) {
- print ";; STORING IP6: $server IN AAAA ",$rr->rdatastr,"\n" if $self->{'debug'};
- push @{ $hints{$server} }, $rr->rdatastr;
- }
- }
-
- }
- }
- }
- foreach my $server (keys %hints) {
- if (!@{ $hints{$server} }) {
- # Wipe the servers without lookups
- delete $hints{$server};
- }
- }
- $self->{'hints'} = \%hints;
- } else {
- $self->{'hints'} = {};
- }
- if (%{ $self->{'hints'} }) {
- if ($self->{'debug'}) {
- print ";; USING THE FOLLOWING HINT IPS:\n";
- foreach my $ips (values %{ $self->{'hints'} }) {
- foreach my $server (@{ $ips }) {
- print ";; $server\n";
- }
- }
- }
- } else {
- warn "Server [".($self->nameservers)[0]."] did not give answers";
- }
-
- # Disable recursion flag.
-
-
- return $self->nameservers( map { @{ $_ } } values %{ $self->{'hints'} } );
-}
-
-
-sub recursion_callback {
- my ($self, $sub) = @_;
-
- if ($sub && UNIVERSAL::isa($sub, 'CODE')) {
- $self->{'callback'} = $sub;
- }
-
- return $self->{'callback'};
-}
-
-
-# $res->query_dorecursion( args );
-# Takes same args as Net::DNS::Resolver->query
-# Purpose: Do that "hot pototo dance" on args.
-sub query_dorecursion {
- my $self = shift;
- my @query = @_;
-
- # Make sure the hint servers are initialized.
- $self->hints unless $self->{'hints'};
- $self->recurse(0);
- # Make sure the authority cache is clean.
- # It is only used to store A and AAAA records of
- # the suposedly authoritative name servers.
- $self->{'authority_cache'} = {};
-
- # Obtain real question Net::DNS::Packet
- my $query_packet = $self->make_query_packet(@query);
-
- # Seed name servers with hints
- return $self->_dorecursion( $query_packet, ".", $self->{'hints'}, 0);
-}
-
-sub _dorecursion {
- my $self = shift;
- my $query_packet = shift;
- my $known_zone = shift;
- my $known_authorities = shift;
- my $depth = shift;
- my $cache = $self->{'authority_cache'};
-
- # die "Recursion too deep, aborting..." if $depth > 255;
- if ( $depth > 255 ) {
- print ";; _dorecursion() Recursion too deep, aborting...\n" if
- $self->{'debug'};
- $self->errorstring="Recursion to deep, abborted";
- return undef;
- }
-
- $known_zone =~ s/\.*$/./;
-
- # Get IPs from authorities
- my @ns = ();
- foreach my $ns (keys %{ $known_authorities }) {
- if (scalar @{ $known_authorities->{$ns} }) {
- $cache->{$ns} = $known_authorities->{$ns};
- push (@ns, @{ $cache->{$ns} });
- } elsif ($cache->{$ns}) {
- $known_authorities->{$ns} = $cache->{$ns};
- push (@ns, @{ $cache->{$ns} });
- }
- }
-
- if (!@ns) {
- my $found_auth = 0;
- if ($self->{'debug'}) {
- require Data::Dumper;
- print ";; _dorecursion() Failed to extract nameserver IPs:\n";
- print Data::Dumper::Dumper([$known_authorities,$cache]);
- }
- foreach my $ns (keys %{ $known_authorities }) {
- if (!@{ $known_authorities->{$ns} }) {
- print ";; _dorecursion() Manual lookup for authority [$ns]\n" if $self->{'debug'};
-
- my $auth_packet;
- my @ans;
-
- # Don't query for V6 if its not there.
- if ($Net::DNS::Resolver::Base::has_inet6 && ! $self->{force_v4}){
- $auth_packet =
- $self->_dorecursion
- ($self->make_query_packet($ns,"AAAA"), # packet
- ".", # known_zone
- $self->{'hints'}, # known_authorities
- $depth+1); # depth
- @ans = $auth_packet->answer if $auth_packet;
- }
-
- $auth_packet =
- $self->_dorecursion
- ($self->make_query_packet($ns,"A"), # packet
- ".", # known_zone
- $self->{'hints'}, # known_authorities
- $depth+1); # depth
-
- push (@ans,$auth_packet->answer ) if $auth_packet;
-
- if ( @ans ) {
- print ";; _dorecursion() Answers found for [$ns]\n" if $self->{'debug'};
- foreach my $rr (@ans) {
- print ";; RR:".$rr->string."\n" if $self->{'debug'};
- if ($rr->type eq "CNAME") {
- # Follow CNAME
- if (my $server = lc $rr->name) {
- $server =~ s/\.*$/./;
- if ($server eq $ns) {
- my $cname = lc $rr->rdatastr;
- $cname =~ s/\.*$/./;
- print ";; _dorecursion() Following CNAME ns [$ns] -> [$cname]\n" if $self->{'debug'};
- $known_authorities->{$cname} ||= [];
- delete $known_authorities->{$ns};
- next;
- }
- }
- } elsif ($rr->type eq "A" ||$rr->type eq "AAAA" ) {
- if (my $server = lc $rr->name) {
- $server =~ s/\.*$/./;
- if ($known_authorities->{$server}) {
- my $ip = $rr->rdatastr;
- print ";; _dorecursion() Found ns: $server IN A $ip\n" if $self->{'debug'};
- $cache->{$server} = $known_authorities->{$server};
- push (@{ $cache->{$ns} }, $ip);
- $found_auth++;
- next;
- }
- }
- }
- print ";; _dorecursion() Ignoring useless answer: ",$rr->string,"\n" if $self->{'debug'};
- }
- } else {
- print ";; _dorecursion() Could not find A records for [$ns]\n" if $self->{'debug'};
- }
- }
- }
- if ($found_auth) {
- print ";; _dorecursion() Found $found_auth new NS authorities...\n" if $self->{'debug'};
- return $self->_dorecursion( $query_packet, $known_zone, $known_authorities, $depth+1);
- }
- print ";; _dorecursion() No authority information could be obtained.\n" if $self->{'debug'};
- return undef;
- }
-
- # Cut the deck of IPs in a random place.
- print ";; _dorecursion() cutting deck of (".scalar(@ns).") authorities...\n" if $self->{'debug'};
- splice(@ns, 0, 0, splice(@ns, int(rand @ns)));
-
-
- LEVEL: foreach my $levelns (@ns){
- print ";; _dorecursion() Trying nameserver [$levelns]\n" if $self->{'debug'};
- $self->nameservers($levelns);
-
- if (my $packet = $self->send( $query_packet )) {
-
- if ($self->{'callback'}) {
- $self->{'callback'}->($packet);
- }
-
- my $of = undef;
- print ";; _dorecursion() Response received from [",$self->answerfrom,"]\n" if $self->{'debug'};
- if (my $status = $packet->header->rcode) {
- if ($status eq "NXDOMAIN") {
- # I guess NXDOMAIN is the best we'll ever get
- print ";; _dorecursion() returning NXDOMAIN\n" if $self->{'debug'};
- return $packet;
- } elsif (my @ans = $packet->answer) {
- print ";; _dorecursion() Answers were found.\n" if $self->{'debug'};
- return $packet;
- } elsif (my @authority = $packet->authority) {
- my %auth = ();
- foreach my $rr (@authority) {
- if ($rr->type =~ /^(NS|SOA)$/) {
- my $server = lc ($1 eq "NS" ? $rr->nsdname : $rr->mname);
- $server =~ s/\.*$/./;
- $of = lc $rr->name;
- $of =~ s/\.*$/./;
- print ";; _dorecursion() Received authority [$of] [",$rr->type(),"] [$server]\n" if $self->{'debug'};
- if (length $of <= length $known_zone) {
- print ";; _dorecursion() Deadbeat name server did not provide new information.\n" if $self->{'debug'};
- next LEVEL;
- } elsif ($of =~ /$known_zone$/) {
- print ";; _dorecursion() FOUND closer authority for [$of] at [$server].\n" if $self->{'debug'};
- $auth{$server} ||= [];
- } else {
- print ";; _dorecursion() Confused name server [",$self->answerfrom,"] thinks [$of] is closer than [$known_zone]?\n" if $self->{'debug'};
- last;
- }
- } else {
- print ";; _dorecursion() Ignoring NON NS entry found in authority section: ",$rr->string,"\n" if $self->{'debug'};
- }
- }
- foreach my $rr ($packet->additional) {
- if ($rr->type eq "CNAME") {
- # Store this CNAME into %auth too
- if (my $server = lc $rr->name) {
- $server =~ s/\.*$/./;
- if ($auth{$server}) {
- my $cname = lc $rr->rdatastr;
- $cname =~ s/\.*$/./;
- print ";; _dorecursion() FOUND CNAME authority: ",$rr->string,"\n" if $self->{'debug'};
- $auth{$cname} ||= [];
- $auth{$server} = $auth{$cname};
- next;
- }
- }
- } elsif ($rr->type eq "A" || $rr->type eq "AAAA") {
- if (my $server = lc $rr->name) {
- $server =~ s/\.*$/./;
- if ($auth{$server}) {
- print ";; _dorecursion() STORING: $server IN A ",$rr->rdatastr,"\n" if $self->{'debug'} && $rr->type eq "A";
- print ";; _dorecursion() STORING: $server IN AAAA ",$rr->rdatastr,"\n" if $self->{'debug'}&& $rr->type eq "AAAA";
- push @{ $auth{$server} }, $rr->rdatastr;
- next;
- }
- }
- }
- print ";; _dorecursion() Ignoring useless: ",$rr->string,"\n" if $self->{'debug'};
- }
- if ($of =~ /$known_zone$/) {
- return $self->_dorecursion( $query_packet, $of, \%auth, $depth+1 );
- } else {
- return $self->_dorecursion( $query_packet, $known_zone, $known_authorities, $depth+1 );
- }
- }
- }
- }
- }
-
- return undef;
-}
-
-1;
-
-__END__
-
-
-=head1 NAME
-
-Net::DNS::Resolver::Recurse - Perform recursive dns lookups
-
-=head1 SYNOPSIS
-
- use Net::DNS::Resolver::Recurse;
- my $res = Net::DNS::Resolver::Recurse->new;
-
-=head1 DESCRIPTION
-
-This module is a sub class of Net::DNS::Resolver. So the methods for
-Net::DNS::Resolver still work for this module as well. There are just a
-couple methods added:
-
-=head2 hints
-
-Initialize the hint servers. Recursive queries need a starting name
-server to work off of. This method takes a list of IP addresses to use
-as the starting servers. These name servers should be authoritative for
-the root (.) zone.
-
- $res->hints(@ips);
-
-If no hints are passed, the default nameserver is asked for the hints.
-Normally these IPs can be obtained from the following location:
-
- ftp://ftp.internic.net/domain/named.root
-
-=head2 recursion_callback
-
-This method is takes a code reference, which is then invoked each time a
-packet is received during the recursive lookup. For example to emulate
-dig's C<+trace> function:
-
- $res->recursion_callback(sub {
- my $packet = shift;
-
- $_->print for $packet->additional;
-
- printf(";; Received %d bytes from %s\n\n",
- $packet->answersize,
- $packet->answerfrom
- );
- });
-
-=head2 query_dorecursion
-
-This method is much like the normal query() method except it disables
-the recurse flag in the packet and explicitly performs the recursion.
-
- $packet = $res->query_dorecursion( "www.netscape.com.", "A");
-
-
-=head1 IPv6 transport
-
-If the appropriate IPv6 libraries are installed the recursive resolver
-will randomly choose between IPv6 and IPv4 addresses of the
-nameservers it encounters during recursion.
-
-If you want to force IPv4 transport use the force_v4() method. Also see
-the IPv6 transport notes in the Net::DNS::Resolver documentation.
-
-=head1 AUTHOR
-
-Rob Brown, bbb@cpan.org
-
-=head1 SEE ALSO
-
-L<Net::DNS::Resolver>,
-
-=head1 COPYRIGHT
-
-Copyright (c) 2002, Rob Brown. All rights reserved.
-Portions Copyright (c) 2005, Olaf M Kolkman.
-
-This module is free software; you can redistribute
-it and/or modify it under the same terms as Perl itself.
-
-$Id: Recurse.pm 591 2006-05-22 21:32:38Z olaf $
-
-=cut
-
-Example lookup process:
-
-[root@box root]# dig +trace www.rob.com.au.
-
-; <<>> DiG 9.2.0 <<>> +trace www.rob.com.au.
-;; global options: printcmd
-. 507343 IN NS C.ROOT-SERVERS.NET.
-. 507343 IN NS D.ROOT-SERVERS.NET.
-. 507343 IN NS E.ROOT-SERVERS.NET.
-. 507343 IN NS F.ROOT-SERVERS.NET.
-. 507343 IN NS G.ROOT-SERVERS.NET.
-. 507343 IN NS H.ROOT-SERVERS.NET.
-. 507343 IN NS I.ROOT-SERVERS.NET.
-. 507343 IN NS J.ROOT-SERVERS.NET.
-. 507343 IN NS K.ROOT-SERVERS.NET.
-. 507343 IN NS L.ROOT-SERVERS.NET.
-. 507343 IN NS M.ROOT-SERVERS.NET.
-. 507343 IN NS A.ROOT-SERVERS.NET.
-. 507343 IN NS B.ROOT-SERVERS.NET.
-;; Received 436 bytes from 127.0.0.1#53(127.0.0.1) in 9 ms
- ;;; But these should be hard coded as the hints
-
- ;;; Ask H.ROOT-SERVERS.NET gave:
-au. 172800 IN NS NS2.BERKELEY.EDU.
-au. 172800 IN NS NS1.BERKELEY.EDU.
-au. 172800 IN NS NS.UU.NET.
-au. 172800 IN NS BOX2.AUNIC.NET.
-au. 172800 IN NS SEC1.APNIC.NET.
-au. 172800 IN NS SEC3.APNIC.NET.
-;; Received 300 bytes from 128.63.2.53#53(H.ROOT-SERVERS.NET) in 322 ms
- ;;; A little closer than before
-
- ;;; Ask NS2.BERKELEY.EDU gave:
-com.au. 259200 IN NS ns4.ausregistry.net.
-com.au. 259200 IN NS dns1.telstra.net.
-com.au. 259200 IN NS au2ld.CSIRO.au.
-com.au. 259200 IN NS audns01.syd.optus.net.
-com.au. 259200 IN NS ns.ripe.net.
-com.au. 259200 IN NS ns1.ausregistry.net.
-com.au. 259200 IN NS ns2.ausregistry.net.
-com.au. 259200 IN NS ns3.ausregistry.net.
-com.au. 259200 IN NS ns3.melbourneit.com.
-;; Received 387 bytes from 128.32.206.12#53(NS2.BERKELEY.EDU) in 10312 ms
- ;;; A little closer than before
-
- ;;; Ask ns4.ausregistry.net gave:
-com.au. 259200 IN NS ns1.ausregistry.net.
-com.au. 259200 IN NS ns2.ausregistry.net.
-com.au. 259200 IN NS ns3.ausregistry.net.
-com.au. 259200 IN NS ns4.ausregistry.net.
-com.au. 259200 IN NS ns3.melbourneit.com.
-com.au. 259200 IN NS dns1.telstra.net.
-com.au. 259200 IN NS au2ld.CSIRO.au.
-com.au. 259200 IN NS ns.ripe.net.
-com.au. 259200 IN NS audns01.syd.optus.net.
-;; Received 259 bytes from 137.39.1.3#53(ns4.ausregistry.net) in 606 ms
- ;;; Uh... yeah... I already knew this
- ;;; from what NS2.BERKELEY.EDU told me.
- ;;; ns4.ausregistry.net must have brain damage
-
- ;;; Ask ns1.ausregistry.net gave:
-rob.com.au. 86400 IN NS sy-dns02.tmns.net.au.
-rob.com.au. 86400 IN NS sy-dns01.tmns.net.au.
-;; Received 87 bytes from 203.18.56.41#53(ns1.ausregistry.net) in 372 ms
- ;;; Ah, much better. Something more useful.
-
- ;;; Ask sy-dns02.tmns.net.au gave:
-www.rob.com.au. 7200 IN A 139.134.5.123
-rob.com.au. 7200 IN NS sy-dns01.tmns.net.au.
-rob.com.au. 7200 IN NS sy-dns02.tmns.net.au.
-;; Received 135 bytes from 139.134.2.18#53(sy-dns02.tmns.net.au) in 525 ms
- ;;; FINALLY, THE ANSWER!
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/Resolver/UNIX.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/Resolver/UNIX.pm
deleted file mode 100644
index 7cff8c76960..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/Resolver/UNIX.pm
+++ /dev/null
@@ -1,74 +0,0 @@
-package Net::DNS::Resolver::UNIX;
-#
-# $Id: UNIX.pm 482 2005-09-02 13:34:33Z olaf $
-#
-
-use strict;
-use vars qw(@ISA $VERSION);
-
-use Net::DNS::Resolver::Base ();
-
-@ISA = qw(Net::DNS::Resolver::Base);
-$VERSION = (qw$LastChangedRevision: 482 $)[1];
-
-my $resolv_conf = '/etc/resolv.conf';
-my $dotfile = '.resolv.conf';
-
-my @config_path;
-push(@config_path, $ENV{'HOME'}) if exists $ENV{'HOME'};
-push(@config_path, '.');
-
-sub init {
- my ($class) = @_;
-
- $class->read_config_file($resolv_conf) if -f $resolv_conf && -r _;
-
- foreach my $dir (@config_path) {
- my $file = "$dir/$dotfile";
- $class->read_config_file($file) if -f $file && -r _ && -o _;
- }
-
- $class->read_env;
-
- my $defaults = $class->defaults;
-
- if (!$defaults->{'domain'} && @{$defaults->{'searchlist'}}) {
- $defaults->{'domain'} = $defaults->{'searchlist'}[0];
- } elsif (!@{$defaults->{'searchlist'}} && $defaults->{'domain'}) {
- $defaults->{'searchlist'} = [ $defaults->{'domain'} ];
- }
-}
-
-1;
-__END__
-
-
-=head1 NAME
-
-Net::DNS::Resolver::UNIX - UNIX Resolver Class
-
-=head1 SYNOPSIS
-
- use Net::DNS::Resolver;
-
-=head1 DESCRIPTION
-
-This class implements the UNIX specific portions of C<Net::DNS::Resolver>.
-
-No user serviceable parts inside, see L<Net::DNS::Resolver|Net::DNS::Resolver>
-for all your resolving needs.
-
-=head1 COPYRIGHT
-
-Copyright (c) 1997-2002 Michael Fuhr.
-
-Portions Copyright (c) 2002-2004 Chris Reinhardt.
-
-All rights reserved. This program is free software; you may redistribute
-it and/or modify it under the same terms as Perl itself.
-
-=head1 SEE ALSO
-
-L<perl(1)>, L<Net::DNS>, L<Net::DNS::Resolver>
-
-=cut
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/Resolver/Win32.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/Resolver/Win32.pm
deleted file mode 100644
index a86d28b8ecf..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/Resolver/Win32.pm
+++ /dev/null
@@ -1,225 +0,0 @@
-package Net::DNS::Resolver::Win32;
-#
-# $Id: Win32.pm 588 2006-05-22 20:28:00Z olaf $
-#
-
-use strict;
-use vars qw(@ISA $VERSION);
-
-use Net::DNS::Resolver::Base ();
-
-@ISA = qw(Net::DNS::Resolver::Base);
-$VERSION = (qw$LastChangedRevision: 588 $)[1];
-
-use Win32::Registry;
-
-sub init {
-
- my $debug=0;
- my ($class) = @_;
-
- my $defaults = $class->defaults;
-
- my ($resobj, %keys);
-
- my $root = 'SYSTEM\CurrentControlSet\Services\Tcpip\Parameters';
-
- unless ($main::HKEY_LOCAL_MACHINE->Open($root, $resobj)) {
- # Didn't work, maybe we are on 95/98/Me?
- $root = 'SYSTEM\CurrentControlSet\Services\VxD\MSTCP';
- $main::HKEY_LOCAL_MACHINE->Open($root, $resobj)
- or Carp::croak "can't read registry: $!";
- }
-
- $resobj->GetValues(\%keys)
- or Carp::croak "can't read registry values: $!";
-
- # Best effort to find a useful domain name for the current host
- # if domain ends up blank, we're probably (?) not connected anywhere
- # a DNS server is interesting either...
- my $domain = $keys{'Domain'}->[2] || $keys{'DhcpDomain'}->[2] || '';
-
- # If nothing else, the searchlist should probably contain our own domain
- # also see below for domain name devolution if so configured
- # (also remove any duplicates later)
- my $searchlist = "$domain ";
- $searchlist .= $keys{'SearchList'}->[2];
-
- # This is (probably) adequate on NT4
- # NameServer overrides DhcpNameServer if both exist
- my $nt4nameservers = $keys{'NameServer'}->[2] || $keys{'DhcpNameServer'}->[2];
- my $nameservers = "";
-
-
-
-#
-#
-# This code is agued to be broken see ticket rt.cpan.org ticket 11931
-# There seems to be sufficient reason to remove this code
-#
-# For details see https://rt.cpan.org/Ticket/Display.html?id=11931
-#
-#
-# #
-# # but on W2K/XP the registry layout is more advanced due to dynamically
-# # appearing connections. So we attempt to handle them, too...
-# # opt to silently fail if something isn't ok (maybe we're on NT4)
-# # drop any duplicates later, but must ignore NT4 style entries if in 2K/XP
-# my $dnsadapters;
-# $resobj->Open("DNSRegisteredAdapters", $dnsadapters);
-# if ($dnsadapters) {
-# my @adapters;
-# $dnsadapters->GetKeys(\@adapters);
-# foreach my $adapter (@adapters) {
-# my $regadapter;
-# $dnsadapters->Open($adapter, $regadapter);
-# if ($regadapter) {
-# my($type,$ns);
-# $regadapter->QueryValueEx("DNSServerAddresses", $type, $ns);
-# while (length($ns) >= 4) {
-# my $addr = join('.', unpack("C4", substr($ns,0,4,"")));
-# $nameservers .= " $addr";
-# }
-# }
-# }
-# }
-
-
-
-
- # This code was introduced by Hanno Stock, see ticket 1193 dd May 19 2006
- #
- # it should work on Win2K and XP and looks for the DNS services
- # using the BIND key
- #
-
- my $bind_linkage;
- my @sorted_interfaces;
- print ";; DNS: Getting sorted interface list\n" if $debug;
- $main::HKEY_LOCAL_MACHINE->Open('SYSTEM\CurrentControlSet\Services\Tcpip\Linkage',
- $bind_linkage);
- if($bind_linkage){
- my $bind_linkage_list;
- my $type;
- $bind_linkage->QueryValueEx('Bind', $type, $bind_linkage_list);
- if($bind_linkage_list){
- @sorted_interfaces = split(m/[^\w{}\\-]+/s, $bind_linkage_list);
- }
- foreach my $interface (@sorted_interfaces){
- $interface =~ s/^\\device\\//i;
- print ";; DNS:Interface: $interface\n" if $debug;
- }
- }
-
-
- my $interfaces;
- $resobj->Open("Interfaces", $interfaces);
- if ($interfaces) {
- my @ifacelist;
- if(@sorted_interfaces){
- @ifacelist = @sorted_interfaces;
- }else{
- $interfaces->GetKeys(\@ifacelist);
- }
- foreach my $iface (@ifacelist) {
- my $regiface;
- $interfaces->Open($iface, $regiface);
-
- if ($regiface) {
- my $ns;
- my $type;
- my $ip;
- my $ipdhcp;
- $regiface->QueryValueEx("IPAddress", $type, $ip);
- $regiface->QueryValueEx("DhcpIPAddress", $type, $ipdhcp);
- if (($ip && !($ip =~ /0\.0\.0\.0/)) || ($ipdhcp && !($ipdhcp =~ /0\.0
-\.0\.0/))) {
- # NameServer overrides DhcpNameServer if both exist
- $regiface->QueryValueEx("NameServer", $type, $ns);
- $regiface->QueryValueEx("DhcpNameServer", $type, $ns) unless $ns;
- $nameservers .= " $ns" if $ns;
- }
- }
- }
- }
- if (!$nameservers) {
- $nameservers = $nt4nameservers;
- }
-
- if ($domain) {
- $defaults->{'domain'} = $domain;
- }
-
- my $usedevolution = $keys{'UseDomainNameDevolution'}->[2];
- if ($searchlist) {
- # fix devolution if configured, and simultaneously make sure no dups (but keep the order)
- my @a;
- my %h;
- foreach my $entry (split(m/[\s,]+/, $searchlist)) {
- push(@a, $entry) unless $h{$entry};
- $h{$entry} = 1;
- if ($usedevolution) {
- # as long there's more than two pieces, cut
- while ($entry =~ m#\..+\.#) {
- $entry =~ s#^[^\.]+\.(.+)$#$1#;
- push(@a, $entry) unless $h{$entry};
- $h{$entry} = 1;
- }
- }
- }
- $defaults->{'searchlist'} = \@a;
- }
-
- if ($nameservers) {
- # remove blanks and dupes
- my @a;
- my %h;
- foreach my $ns (split(m/[\s,]+/, $nameservers)) {
- push @a, $ns unless (!$ns || $h{$ns});
- $h{$ns} = 1;
- }
- $defaults->{'nameservers'} = [map { m/(.*)/ } @a];
- }
-
- $class->read_env;
-
- if (!$defaults->{'domain'} && @{$defaults->{'searchlist'}}) {
- $defaults->{'domain'} = $defaults->{'searchlist'}[0];
- } elsif (!@{$defaults->{'searchlist'}} && $defaults->{'domain'}) {
- $defaults->{'searchlist'} = [ $defaults->{'domain'} ];
- }
-}
-
-1;
-__END__
-
-
-=head1 NAME
-
-Net::DNS::Resolver::Win32 - Windows Resolver Class
-
-=head1 SYNOPSIS
-
- use Net::DNS::Resolver;
-
-=head1 DESCRIPTION
-
-This class implements the windows specific portions of C<Net::DNS::Resolver>.
-
-No user serviceable parts inside, see L<Net::DNS::Resolver|Net::DNS::Resolver>
-for all your resolving needs.
-
-=head1 COPYRIGHT
-
-Copyright (c) 1997-2002 Michael Fuhr.
-
-Portions Copyright (c) 2002-2004 Chris Reinhardt.
-
-All rights reserved. This program is free software; you may redistribute
-it and/or modify it under the same terms as Perl itself.
-
-=head1 SEE ALSO
-
-L<perl(1)>, L<Net::DNS>, L<Net::DNS::Resolver>
-
-=cut
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/Update.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/Update.pm
deleted file mode 100644
index e4b38c47d34..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/Update.pm
+++ /dev/null
@@ -1,200 +0,0 @@
-package Net::DNS::Update;
-#
-# $Id: Update.pm 517 2005-11-21 08:38:47Z olaf $
-#
-use strict;
-BEGIN {
- eval { require bytes; }
-}
-use vars qw($VERSION @ISA);
-
-use Net::DNS;
-
-@ISA = qw(Net::DNS::Packet);
-$VERSION = (qw$LastChangedRevision: 517 $)[1];
-
-=head1 NAME
-
-Net::DNS::Update - Create a DNS update packet
-
-=head1 SYNOPSIS
-
-C<use Net::DNS::Update;>
-
-=head1 DESCRIPTION
-
-C<Net::DNS::Update> is a subclass of C<Net::DNS::Packet>,
-to be used for making DNS dynamic updates. Programmers
-should refer to RFC 2136 for the semantics of dynamic updates.
-
-WARNING: This code is still under development. Please use with
-caution on production nameservers.
-
-=head1 METHODS
-
-=head2 new
-
- $packet = Net::DNS::Update->new;
- $packet = Net::DNS::Update->new('example.com');
- $packet = Net::DNS::Update->new('example.com', 'HS');
-
-Returns a C<Net::DNS::Update> object suitable for performing a DNS
-dynamic update. Specifically, it creates a packet with the header
-opcode set to UPDATE and the zone record type to SOA (per RFC 2136,
-Section 2.3).
-
-Programs must use the C<push> method to add RRs to the prerequisite,
-update, and additional sections before performing the update.
-
-Arguments are the zone name and the class. If the zone is omitted,
-the default domain will be taken from the resolver configuration.
-If the class is omitted, it defaults to IN.
-
-Future versions of C<Net::DNS> may provide a simpler interface
-for making dynamic updates.
-
-=cut
-
-sub new {
- my ($package, $zone, $class) = @_;
-
- unless ($zone) {
- my $res = Net::DNS::Resolver->new;
- $zone = ($res->searchlist)[0];
- return unless $zone;
- }
-
- my $type = 'SOA';
- $class ||= 'IN';
-
- my $self = $package->SUPER::new($zone, $type, $class) || return;
-
- $self->header->opcode('UPDATE');
- $self->header->rd(0);
-
- $self->{'seen'} = {};
-
-
- return $self;
-}
-
-
-=head1 EXAMPLES
-
-The first example below shows a complete program; subsequent examples
-show only the creation of the update packet.
-
-=head2 Add a new host
-
- #!/usr/bin/perl -w
-
- use Net::DNS;
- use strict;
-
- # Create the update packet.
- my $update = Net::DNS::Update->new('example.com');
-
- # Prerequisite is that no A records exist for the name.
- $update->push(pre => nxrrset('foo.example.com. A'));
-
- # Add two A records for the name.
- $update->push(update => rr_add('foo.example.com. 86400 A 192.168.1.2'));
- $update->push(update => rr_add('foo.example.com. 86400 A 172.16.3.4'));
-
- # Send the update to the zone's primary master.
- my $res = Net::DNS::Resolver->new;
- $res->nameservers('primary-master.example.com');
-
- my $reply = $res->send($update);
-
- # Did it work?
- if ($reply) {
- if ($reply->header->rcode eq 'NOERROR') {
- print "Update succeeded\n";
- } else {
- print 'Update failed: ', $reply->header->rcode, "\n";
- }
- } else {
- print 'Update failed: ', $res->errorstring, "\n";
- }
-
-=head2 Add an MX record for a name that already exists
-
- my $update = Net::DNS::Update->new('example.com');
- $update->push(pre => yxdomain('example.com'));
- $update->push(update => rr_add('example.com MX 10 mailhost.example.com'));
-
-=head2 Add a TXT record for a name that doesn't exist
-
- my $update = Net::DNS::Update->new('example.com');
- $update->push(pre => nxdomain('info.example.com'));
- $update->push(update => rr_add('info.example.com TXT "yabba dabba doo"'));
-
-=head2 Delete all A records for a name
-
- my $update = Net::DNS::Update->new('example.com');
- $update->push(pre => yxrrset('foo.example.com A'));
- $update->push(update => rr_del('foo.example.com A'));
-
-=head2 Delete all RRs for a name
-
- my $update = Net::DNS::Update->new('example.com');
- $update->push(pre => yxdomain('byebye.example.com'));
- $update->push(update => rr_del('byebye.example.com'));
-
-=head2 Perform a signed update
-
- my $key_name = 'tsig-key';
- my $key = 'awwLOtRfpGE+rRKF2+DEiw==';
-
- my $update = Net::DNS::Update->new('example.com');
- $update->push(update => rr_add('foo.example.com A 10.1.2.3'));
- $update->push(update => rr_add('bar.example.com A 10.4.5.6'));
- $update->sign_tsig($key_name, $key);
-
-=head2 Another way to perform a signed update
-
- my $key_name = 'tsig-key';
- my $key = 'awwLOtRfpGE+rRKF2+DEiw==';
-
- my $update = Net::DNS::Update->new('example.com');
- $update->push(update => rr_add('foo.example.com A 10.1.2.3'));
- $update->push(update => rr_add('bar.example.com A 10.4.5.6'));
- $update->push(additional => Net::DNS::RR->new("$key_name TSIG $key"));
-
-=head2 Perform a signed update with a customized TSIG record
-
- my $key_name = 'tsig-key';
- my $key = 'awwLOtRfpGE+rRKF2+DEiw==';
-
- my $tsig = Net::DNS::RR->new("$key_name TSIG $key");
- $tsig->fudge(60);
-
- my $update = Net::DNS::Update->new('example.com');
- $update->push(update => rr_add('foo.example.com A 10.1.2.3'));
- $update->push(update => rr_add('bar.example.com A 10.4.5.6'));
- $update->push(additional => $tsig);
-
-=head1 BUGS
-
-This code is still under development. Please use with caution on
-production nameservers.
-
-=head1 COPYRIGHT
-
-Copyright (c) 1997-2002 Michael Fuhr.
-
-Portions Copyright (c) 2002-2004 Chris Reinhardt.
-
-All rights reserved. This program is free software; you may redistribute
-it and/or modify it under the same terms as Perl itself.
-
-=head1 SEE ALSO
-
-L<perl(1)>, L<Net::DNS>, L<Net::DNS::Resolver>, L<Net::DNS::Header>,
-L<Net::DNS::Packet>, L<Net::DNS::Question>, L<Net::DNS::RR>, RFC 2136,
-RFC 2845
-
-=cut
-
-1;
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/PadWalker.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/PadWalker.pm
deleted file mode 100644
index 7c14f3e38ea..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/PadWalker.pm
+++ /dev/null
@@ -1,154 +0,0 @@
-package PadWalker;
-
-use strict;
-use vars qw($VERSION @ISA @EXPORT_OK %EXPORT_TAGS);
-
-require Exporter;
-require DynaLoader;
-
-require 5.008;
-
-@ISA = qw(Exporter DynaLoader);
-@EXPORT_OK = qw(peek_my peek_our closed_over peek_sub var_name);
-%EXPORT_TAGS = (all => \@EXPORT_OK);
-
-$VERSION = '1.7';
-
-bootstrap PadWalker $VERSION;
-
-sub peek_my;
-sub peek_our;
-sub closed_over;
-sub peek_sub;
-sub var_name;
-
-1;
-__END__
-
-=head1 NAME
-
-PadWalker - play with other peoples' lexical variables
-
-=head1 SYNOPSIS
-
- use PadWalker qw(peek_my peek_our peek_sub closed_over);
- ...
-
-=head1 DESCRIPTION
-
-PadWalker is a module which allows you to inspect (and even change!)
-lexical variables in any subroutine which called you. It will only
-show those variables which are in scope at the point of the call.
-
-PadWalker is particularly useful for debugging. It's even
-used by Perl's built-in debugger. (It can also be used
-for evil, of course.)
-
-I wouldn't recommend using PadWalker directly in production
-code, but it's your call. Some of the modules that use
-PadWalker internally are certainly safe for and useful
-in production.
-
-=over 4
-
-=item peek_my LEVEL
-
-=item peek_our LEVEL
-
-The LEVEL argument is interpreted just like the argument to C<caller>.
-So C<peek_my(0)> returns a reference to a hash of all the C<my>
-variables that are currently in scope;
-C<peek_my(1)> returns a reference to a hash of all the C<my>
-variables that are in scope at the point where the current
-sub was called, and so on.
-
-C<peek_our> works in the same way, except that it lists
-the C<our> variables rather than the C<my> variables.
-
-The hash associates each variable name with a reference
-to its value. The variable names include the sigil, so
-the variable $x is represented by the string '$x'.
-
-For example:
-
- my $x = 12;
- my $h = peek_my (0);
- ${$h->{'$x'}}++;
-
- print $x; # prints 13
-
-Or a more complex example:
-
- sub increment_my_x {
- my $h = peek_my (1);
- ${$h->{'$x'}}++;
- }
-
- my $x=5;
- increment_my_x;
- print $x; # prints 6
-
-=item peek_sub SUB
-
-The C<peek_sub> routine takes a coderef as its argument, and returns a hash
-of the C<my> variables used in that sub. The values will usually be undefined
-unless the sub is in use (i.e. in the call-chain) at the time. On the other
-hand:
-
- my $x = "Hello!";
- my $r = peek_sub(sub {$x})->{'$x'};
- print "$$r\n"; # prints 'Hello!'
-
-If the sub defines several C<my> variables with the same name, you'll get the
-last one. I don't know of any use for C<peek_sub> that isn't broken as a result
-of this, and it will probably be deprecated in a future version in favour of
-some alternative interface.
-
-=item closed_over SUB
-
-C<closed_over> is similar to C<peek_sub>, except that it only lists
-the C<my> variables which are used in the subroutine but defined outside:
-in other words, the variables which it closes over. This I<does> have
-reasonable uses: see L<Data::Dump::Streamer>, for example (a future version
-of which may in fact use C<closed_over>).
-
-=item var_name LEVEL, VAR_REF
-
-=item var_name SUB, VAR_REF
-
-C<var_name(sub, var_ref)> returns the name of the variable referred to
-by C<var_ref>, provided it is a C<my> variable used in the sub. The C<sub>
-parameter can be either a CODE reference or a number. If it's a number,
-it's treated the same way as the argument to C<peek_my>.
-
-For example,
-
- my $foo;
- print var_name(0, \$foo); # prints '$foo'
-
- sub my_name {
- return var_name(1, shift);
- }
- print my_name(\$foo); # ditto
-
-=back
-
-=head1 AUTHOR
-
-Robin Houston <robin@cpan.org>
-
-With contributions from Richard Soberberg, bug-spotting
-from Peter Scott and Dave Mitchell, and suggestions from
-demerphq.
-
-=head1 SEE ALSO
-
-Devel::LexAlias, Devel::Caller, Sub::Parameters
-
-=head1 COPYRIGHT
-
-Copyright (c) 2000-2007, Robin Houston. All Rights Reserved.
-This module is free software. It may be used, redistributed
-and/or modified under the same terms as Perl itself.
-
-=cut
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Proc/Killall.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Proc/Killall.pm
deleted file mode 100644
index 9e8f1642543..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Proc/Killall.pm
+++ /dev/null
@@ -1,111 +0,0 @@
-#
-# Kill all instances of a process by pattern-matching the command-line
-#
-# (c) 2000 by Aaron Sherman, see documentation, below for details.
-
-package Proc::Killall;
-
-require Exporter;
-use Carp;
-use Proc::ProcessTable;
-use Config;
-use strict;
-use vars qw(@EXPORT @EXPORT_OK @ISA $VERSION);
-
-@EXPORT=qw(killall);
-@EXPORT_OK=qw(killall);
-@ISA=qw(Exporter);
-
-$VERSION='1.0';
-sub VERSION {$VERSION}
-
-# Private function for checking to see if a signal identifier is
-# valid.
-sub is_sig {
- my $sig = shift;
- if (defined($sig)) {
- if ($sig =~ /^-?(\d+)/) {
- my $n = $1;
- my @sigs = split ' ', $Config{sig_num};
- return grep {$_ == $n} @sigs;
- } elsif ($sig =~ /^[A-Z][A-Z0-9]+$/) {
- my @sigs = split ' ', $Config{sig_name};
- return grep {$_ eq $sig} @sigs;
- } else {
- return 0;
- }
- } else {
- return 0;
- }
-}
-
-# usage: killall(signal, pattern)
-# return: number of procs killed
-sub killall {
- croak("Usage: killall(signal, pattern)") unless @_==2;
- my $signal = shift;
- my $pat = shift;
- my $self = shift;
- $self = 0 unless defined $self;
- my $nkilled = 0;
- croak("killall: Unsupported signal: $signal") unless is_sig($signal);
- my $t = new Proc::ProcessTable;
- my $BANG = undef;
- foreach my $p (@{$t->table}) {
- my $cmndline = $p->{cmndline} || $p->{fname};
- if ($cmndline =~ /$pat/) {
- next unless $p->pid != $$ || $self;
- if (kill $signal, $p->pid) {
- $nkilled++;
- } else {
- $BANG = $!;
- }
- }
- }
- $! = $BANG if defined $BANG;
- return $nkilled;
-}
-
-1;
-
-__END__
-
-=head1 NAME
-
-killall - Kill all instances of a process by pattern matching the command-line
-
-=head1 SYNOPSIS
-
- use Proc::Killall;
-
- killall('HUP', 'xterm'); # SIGHUP all xterms
- killall('KILL', '^netscape$'); # SIGKILL to "netscape"
-
-=head1 DESCRIPTION
-
-This module provides one function, C<killall()>, which takes two parameters:
-a signal name or number (see C<kill()>) and a process pattern. This pattern
-is matched against the process' command-line as the C<ps> command would
-show it (C<ps> is not used internally, instead a package called
-C<Proc::ProcessTable> is used).
-
-C<killall> searches the process table and sends that signal to all processes
-which match the pattern. The return value is the number of processes that
-were succesfully signaled. If any kills failed, the C<$!> variable
-will be set based on that last one that failed (even if a successful kill
-happened afterward).
-
-=head1 AUTHOR
-
-Written in 2000 by Aaron Sherman E<lt>ajs@ajs.comE<gt>
-
-C<Proc::Killall> is copyright 2000 by Aaron Sherman, and may be
-distributed under the same terms as Perl itself.
-
-=head1 PREREQUISITES
-
-C<Proc::ProcessTable> is required for C<Proc::Killall> to function.
-
-=head1 SEE ALSO
-
-L<perl>, L<perlfunc>, L<perlvar>, L<Proc::ProcessTable>
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Proc/Killfam.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Proc/Killfam.pm
deleted file mode 100644
index 6f785cb5616..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Proc/Killfam.pm
+++ /dev/null
@@ -1,83 +0,0 @@
-$Proc::Killfam::VERSION = '1.0';
-
-package Proc::Killfam;
-
-use Exporter;
-use base qw/Exporter/;
-use subs qw/get_pids/;
-use vars qw/@EXPORT @EXPORT_OK $ppt_OK/;
-use strict;
-
-@EXPORT = qw/killfam/;
-@EXPORT_OK = qw/killfam/;
-
-BEGIN {
- $ppt_OK = 1;
- eval "require Proc::ProcessTable";
- if ($@) {
- $ppt_OK = 0;
- warn "Proc::ProcessTable missing, can't kill sub-children.";
- }
-}
-
-sub killfam {
-
- my($signal, @pids) = @_;
-
- if ($ppt_OK) {
- my $pt = Proc::ProcessTable->new;
- my(@procs) = @{$pt->table};
- my(@kids) = get_pids \@procs, @pids;
- @pids = (@pids, @kids);
- }
-
- kill $signal, @pids;
-
-} # end killfam
-
-sub get_pids {
-
- my($procs, @kids) = @_;
-
- my @pids;
- foreach my $kid (@kids) {
- foreach my $proc (@$procs) {
- if ($proc->ppid == $kid) {
- my $pid = $proc->pid;
- push @pids, $pid, get_pids $procs, $pid;
- }
- }
- }
- @pids;
-
-} # end get_pids
-
-1;
-
-__END__
-
-=head1 NAME
-
-Proc::Killfam - kill a list of pids, and all their sub-children
-
-=head1 SYNOPSIS
-
- use Proc::Killfam;
- killfam $signal, @pids;
-
-=head1 DESCRIPTION
-
-B<killfam> accepts the same arguments as the Perl builtin B<kill> command,
-but, additionally, recursively searches the process table for children and
-kills them as well.
-
-=head1 EXAMPLE
-
-B<killfam 'TERM', ($pid1, $pid2, @more_pids)>;
-
-=head1 KEYWORDS
-
-kill, signal
-
-=cut
-
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Proc/ProcessTable.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Proc/ProcessTable.pm
deleted file mode 100644
index a82cdd4b42f..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Proc/ProcessTable.pm
+++ /dev/null
@@ -1,232 +0,0 @@
-package Proc::ProcessTable;
-
-require 5.6.0;
-
-use strict;
-use Carp;
-use vars qw($VERSION @ISA @EXPORT @EXPORT_OK $AUTOLOAD);
-
-require Exporter;
-require DynaLoader;
-
-@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(
-
-);
-$VERSION = '0.42';
-
-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/.*:://;
- my $val = constant($constname, @_ ? $_[0] : 0);
- if ($! != 0) {
- if ($! =~ /Invalid/) {
- $AutoLoader::AUTOLOAD = $AUTOLOAD;
- goto &AutoLoader::AUTOLOAD;
- }
- else {
- croak "Your vendor has not defined Proc::ProcessTable macro $constname";
- }
- }
- eval "sub $AUTOLOAD { $val }";
- goto &$AUTOLOAD;
-}
-
-bootstrap Proc::ProcessTable $VERSION;
-
-# Preloaded methods go here.
-use Proc::ProcessTable::Process;
-use File::Find;
-
-my %TTYDEVS;
-my $TTYDEVSFILE = "/tmp/TTYDEVS"; # Where we store the TTYDEVS hash
-
-sub new
-{
- my ($this, %args) = @_;
- my $class = ref($this) || $this;
- my $self = {};
- bless $self, $class;
-
- mutex_new(1);
- if ( exists $args{cache_ttys} && $args{cache_ttys} == 1 )
- {
- $self->{cache_ttys} = 1
- }
-
- my $status = $self->initialize;
- mutex_new(0);
- if($status)
- {
- return $self;
- }
- else
- {
- return undef;
- }
-}
-
-sub initialize
-{
- my ($self) = @_;
-
- # Get the mapping of TTYs to device nums
- # reading/writing the cache if we are caching
- if( $self->{cache_ttys} )
- {
-
- require Storable;
-
- if( -r $TTYDEVSFILE )
- {
- $_ = Storable::retrieve($TTYDEVSFILE);
- %Proc::ProcessTable::TTYDEVS = %$_;
- }
- else
- {
- $self->_get_tty_list;
- my $old_umask = umask;
- umask 022;
- Storable::store(\%Proc::ProcessTable::TTYDEVS, $TTYDEVSFILE);
- umask $old_umask;
- }
- }
- else
- {
- $self->_get_tty_list;
- }
-
- # Call the os-specific initialization
- $self->_initialize_os;
-
- return 1;
-}
-
-###############################################
-# Generate a hash mapping TTY numbers to paths.
-# This might be faster in Table.xs,
-# but it's a lot more portable here
-###############################################
-sub _get_tty_list
-{
- my ($self) = @_;
- undef %Proc::ProcessTable::TTYDEVS;
- find({ wanted =>
- sub{
- $File::Find::prune = 1 if -d $_ && ! -x $_;
- my($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
- $atime,$mtime,$ctime,$blksize,$blocks) = stat($File::Find::name);
- $Proc::ProcessTable::TTYDEVS{$rdev} = $File::Find::name
- if(-c $File::Find::name);
- }, no_chdir => 1},
- "/dev"
- );
-}
-
-# Apparently needed for mod_perl
-sub DESTROY {}
-
-1;
-__END__
-
-=head1 NAME
-
-Proc::ProcessTable - Perl extension to access the unix process table
-
-=head1 SYNOPSIS
-
- use Proc::ProcessTable;
-
- $p = new Proc::ProcessTable( 'cache_ttys' => 1 );
- @fields = $p->fields;
- $ref = $p->table;
-
-=head1 DESCRIPTION
-
-Perl interface to the unix process table.
-
-=head1 METHODS
-
-=over 4
-
-=item new
-
-Creates a new ProcessTable object. The constructor can take one flag:
-
-cache_ttys -- causes the constructor to look for and use a file that
-caches a mapping of tty names to device numbers, and to create the
-file if it doesn't exist (this file is /tmp/TTYDEVS by default). This
-feature requires the Storable module.
-
-=item fields
-
-Returns a list of the field names supported by the module on the
-current architecture.
-
-=item table
-
-Reads the process table and returns a reference to an array of
-Proc::ProcessTable::Process objects. Attributes of a process object
-are returned by accessors named for the attribute; for example, to get
-the uid of a process just do:
-
-$process->uid
-
-The priority and pgrp methods also allow values to be set, since these
-are supported directly by internal perl functions.
-
-=back
-
-=head1 EXAMPLES
-
- # A cheap and sleazy version of ps
- use Proc::ProcessTable;
-
- $FORMAT = "%-6s %-10s %-8s %-24s %s\n";
- $t = new Proc::ProcessTable;
- printf($FORMAT, "PID", "TTY", "STAT", "START", "COMMAND");
- foreach $p ( @{$t->table} ){
- printf($FORMAT,
- $p->pid,
- $p->ttydev,
- $p->state,
- scalar(localtime($p->start)),
- $p->cmndline);
- }
-
-
- # Dump all the information in the current process table
- use Proc::ProcessTable;
-
- $t = new Proc::ProcessTable;
-
- foreach $p (@{$t->table}) {
- print "--------------------------------\n";
- foreach $f ($t->fields){
- print $f, ": ", $p->{$f}, "\n";
- }
- }
-
-
-=head1 CAVEATS
-
-Please see the file README in the distribution for a list of supported
-operating systems. Please see the file PORTING for information on how
-to help make this work on your OS.
-
-=head1 AUTHOR
-
-D. Urist, durist@frii.com
-
-=head1 SEE ALSO
-
-Proc::ProcessTable::Process.pm, perl(1).
-
-=cut
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Proc/ProcessTable/Process.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Proc/ProcessTable/Process.pm
deleted file mode 100644
index cc1f990f9e7..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Proc/ProcessTable/Process.pm
+++ /dev/null
@@ -1,182 +0,0 @@
-package Proc::ProcessTable::Process;
-
-use strict;
-use vars qw($VERSION @ISA @EXPORT @EXPORT_OK $AUTOLOAD);
-
-require Exporter;
-require AutoLoader;
-
-@ISA = qw(Exporter AutoLoader);
-# 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(
-
-);
-$VERSION = '0.02';
-
-
-# Preloaded methods go here.
-use Carp;
-use File::Basename;
-
-sub AUTOLOAD {
- my $self = shift;
- my $type = ref($self)
- or croak "$self is not an object";
-
- my $name = $AUTOLOAD;
- $name =~ s/.*://; # strip fully-qualified portion
-
- unless (exists $self->{$name} ) {
- croak "Can't access `$name' field in class $type";
- }
-
- if (@_) {
- return $self->{$name} = shift;
- } else {
- return $self->{$name};
- }
-}
-
-########################################################
-# Kill; just a wrapper for perl's kill at the moment
-########################################################
-sub kill {
- my ($self, $signal) = @_;
- return( kill($signal, $self->pid) );
-}
-
-########################################################
-# Get/set accessors for priority and process group
-# (everything else is just a get, so handled by autoload)
-#########################################################
-
-# Hmmm... These could use the perl functions to get if not stored on the object
-sub priority {
- my ($self, $priority) = @_;
- if( defined($priority) ){
- setpriority(0, $self->pid, $priority);
- if( getpriority(0, $self->pid) == $priority ){ # Yuck; getpriority doesn't return a status
- $self->{priority} = $priority;
- }
- }
- return $self->{priority};
-}
-
-sub pgrp {
- my ($self, $pgrp) = @_;
- if( defined($pgrp) ){
- setpgrp($self->pid, $pgrp);
- if( getpgrp($self->pid) == $pgrp ){ # Ditto setpgrp
- $self->{pgrp} = $pgrp;
- }
- }
- return $self->{pgrp};
-}
-
-
-# Apparently needed for mod_perl
-sub DESTROY {}
-
-# Autoload methods go after =cut, and are processed by the autosplit program.
-
-1;
-__END__
-
-=head1 NAME
-
-Proc::ProcessTable::Process - Perl process objects
-
-=head1 SYNOPSIS
-
- $process->kill(9);
- $process->priority(19);
- $process->pgrp(500);
- $uid = $process->uid;
- ...
-
-=head1 DESCRIPTION
-
-This is a stub module to provide OO process attribute access for
-Proc::ProcessTable. Proc::ProcessTable::Process objects are
-constructed directly by Proc::ProcessTable; there is no constructor
-method, only accessors.
-
-=head1 METHODS
-
-=over 4
-
-=item kill
-
-Sends a signal to the process; just an aesthetic wrapper for perl's
-kill. Takes the signal (name or number) as an argument. Returns number
-of processes signalled.
-
-=item priority
-
-Get/set accessor; if called with a numeric argument, attempts to reset
-the process's priority to that number using perl's <B>setpriority
-function. Returns the process priority.
-
-=item pgrp
-
-Same as above for the process group.
-
-=item all other methods...
-
-are simple accessors that retrieve the process attributes for which
-they are named. Currently supported are:
-
- uid UID of process
- gid GID of process
- euid effective UID of process (Solaris only)
- egid effective GID of process (Solaris only)
- pid process ID
- ppid parent process ID
- spid sprod ID (IRIX only)
- pgrp process group
- sess session ID
- cpuid CPU ID of processor running on (IRIX only)
- priority priority of process
- ttynum tty number of process
- flags flags of process
- minflt minor page faults (Linux only)
- cminflt child minor page faults (Linux only)
- majflt major page faults (Linux only)
- cmajflt child major page faults (Linux only)
- utime user mode time (1/100s of seconds) (Linux only)
- stime kernel mode time (Linux only)
- cutime child utime (Linux only)
- cstime child stime (Linux only)
- time user + system time
- ctime child user + system time
- timensec user + system nanoseconds part (Solaris only)
- ctimensec child user + system nanoseconds (Solaris only)
- qtime cumulative cpu time (IRIX only)
- size virtual memory size (bytes)
- rss resident set size (bytes)
- wchan address of current system call
- fname file name
- start start time (seconds since the epoch)
- pctcpu percent cpu used since process started
- state state of process
- pctmem percent memory
- cmndline full command line of process
- ttydev path of process's tty
- clname scheduling class name (IRIX only)
-
-See the "README.osname" files in the distribution for more
-up-to-date information.
-
-=back
-
-=head1 AUTHOR
-
-D. Urist, durist@frii.com
-
-=head1 SEE ALSO
-
-Proc::ProcessTable.pm, perl(1).
-
-=cut
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Proc/example.pl b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Proc/example.pl
deleted file mode 100644
index f84728428cb..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Proc/example.pl
+++ /dev/null
@@ -1,16 +0,0 @@
-#!/usr/bin/perl
-
-use Proc::ProcessTable;
-
-$ref = new Proc::ProcessTable;
-
-foreach $proc (@{$ref->table}) {
- if(@ARGV) {
- next unless grep {$_ == $proc->{pid}} @ARGV;
- }
-
- print "--------------------------------\n";
- foreach $field ($ref->fields){
- print $field, ": ", $proc->{$field}, "\n";
- }
-}
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Term/ReadKey.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Term/ReadKey.pm
deleted file mode 100644
index 077ab5de1a1..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Term/ReadKey.pm
+++ /dev/null
@@ -1,564 +0,0 @@
-#
-# $Id: ReadKey.pm,v 2.23 2005/01/11 21:16:31 jonathan Exp $
-#
-
-=head1 NAME
-
-Term::ReadKey - A perl module for simple terminal control
-
-=head1 SYNOPSIS
-
- use Term::ReadKey;
- ReadMode 4; # Turn off controls keys
- while (not defined ($key = ReadKey(-1))) {
- # No key yet
- }
- print "Get key $key\n";
- ReadMode 0; # Reset tty mode before exiting
-
-=head1 DESCRIPTION
-
-Term::ReadKey is a compiled perl module dedicated to providing simple
-control over terminal driver modes (cbreak, raw, cooked, etc.,) support for
-non-blocking reads, if the architecture allows, and some generalized handy
-functions for working with terminals. One of the main goals is to have the
-functions as portable as possible, so you can just plug in "use
-Term::ReadKey" on any architecture and have a good likelyhood of it working.
-
-=over 8
-
-=item ReadMode MODE [, Filehandle]
-
-Takes an integer argument, which can currently be one of the following
-values:
-
- 0 Restore original settings.
- 1 Change to cooked mode.
- 2 Change to cooked mode with echo off.
- (Good for passwords)
- 3 Change to cbreak mode.
- 4 Change to raw mode.
- 5 Change to ultra-raw mode.
- (LF to CR/LF translation turned off)
-
- Or, you may use the synonyms:
-
- restore
- normal
- noecho
- cbreak
- raw
- ultra-raw
-
-These functions are automatically applied to the STDIN handle if no
-other handle is supplied. Modes 0 and 5 have some special properties
-worth mentioning: not only will mode 0 restore original settings, but it
-cause the next ReadMode call to save a new set of default settings. Mode
-5 is similar to mode 4, except no CR/LF translation is performed, and if
-possible, parity will be disabled (only if not being used by the terminal,
-however. It is no different from mode 4 under Windows.)
-
-If you are executing another program that may be changing the terminal mode,
-you will either want to say
-
- ReadMode 1
- system('someprogram');
- ReadMode 1;
-
-which resets the settings after the program has run, or:
-
- $somemode=1;
- ReadMode 0;
- system('someprogram');
- ReadMode 1;
-
-which records any changes the program may have made, before resetting the
-mode.
-
-=item ReadKey MODE [, Filehandle]
-
-Takes an integer argument, which can currently be one of the following
-values:
-
- 0 Perform a normal read using getc
- -1 Perform a non-blocked read
- >0 Perform a timed read
-
-(If the filehandle is not supplied, it will default to STDIN.) If there is
-nothing waiting in the buffer during a non-blocked read, then undef will be
-returned. Note that if the OS does not provide any known mechanism for
-non-blocking reads, then a C<ReadKey -1> can die with a fatal error. This
-will hopefully not be common.
-
-If MODE is greater then zero, then ReadKey will use it as a timeout value in
-seconds (fractional seconds are allowed), and won't return C<undef> until
-that time expires. (Note, again, that some OS's may not support this timeout
-behaviour.) If MODE is less then zero, then this is treated as a timeout
-of zero, and thus will return immediately if no character is waiting. A MODE
-of zero, however, will act like a normal getc.
-
-There are currently some limitations with this call under Windows. It may be
-possible that non-blocking reads will fail when reading repeating keys from
-more then one console.
-
-=item ReadLine MODE [, Filehandle]
-
-Takes an integer argument, which can currently be one of the following
-values:
-
- 0 Perform a normal read using scalar(<FileHandle>)
- -1 Perform a non-blocked read
- >0 Perform a timed read
-
-If there is nothing waiting in the buffer during a non-blocked read, then
-undef will be returned. Note that if the OS does not provide any known
-mechanism for non-blocking reads, then a C<ReadLine 1> can die with a fatal
-error. This will hopefully not be common. Note that a non-blocking test is
-only performed for the first character in the line, not the entire line.
-This call will probably B<not> do what you assume, especially with
-ReadMode's higher then 1. For example, pressing Space and then Backspace
-would appear to leave you where you started, but any timeouts would now
-be suspended.
-
-This call is currently not available under Windows.
-
-=item GetTerminalSize [Filehandle]
-
-Returns either an empty array if this operation is unsupported, or a four
-element array containing: the width of the terminal in characters, the
-height of the terminal in character, the width in pixels, and the height in
-pixels. (The pixel size will only be valid in some environments.)
-
-Under Windows, this function must be called with an "output" filehandle,
-such as STDOUT, or a handle opened to CONOUT$.
-
-=item SetTerminalSize WIDTH,HEIGHT,XPIX,YPIX [, Filehandle]
-
-Return -1 on failure, 0 otherwise. Note that this terminal size is only for
-B<informative> value, and changing the size via this mechanism will B<not>
-change the size of the screen. For example, XTerm uses a call like this when
-it resizes the screen. If any of the new measurements vary from the old, the
-OS will probably send a SIGWINCH signal to anything reading that tty or pty.
-
-This call does not work under Windows.
-
-=item GetSpeeds [, Filehandle]
-
-Returns either an empty array if the operation is unsupported, or a two
-value array containing the terminal in and out speeds, in B<decimal>. E.g,
-an in speed of 9600 baud and an out speed of 4800 baud would be returned as
-(9600,4800). Note that currently the in and out speeds will always be
-identical in some OS's. No speeds are reported under Windows.
-
-=item GetControlChars [, Filehandle]
-
-Returns an array containing key/value pairs suitable for a hash. The pairs
-consist of a key, the name of the control character/signal, and the value
-of that character, as a single character. This call does nothing under Windows.
-
-Each key will be an entry from the following list:
-
- DISCARD
- DSUSPEND
- EOF
- EOL
- EOL2
- ERASE
- ERASEWORD
- INTERRUPT
- KILL
- MIN
- QUIT
- QUOTENEXT
- REPRINT
- START
- STATUS
- STOP
- SUSPEND
- SWITCH
- TIME
-
-Thus, the following will always return the current interrupt character,
-regardless of platform.
-
- %keys = GetControlChars;
- $int = $keys{INTERRUPT};
-
-=item SetControlChars [, Filehandle]
-
-Takes an array containing key/value pairs, as a hash will produce. The pairs
-should consist of a key that is the name of a legal control
-character/signal, and the value should be either a single character, or a
-number in the range 0-255. SetControlChars will die with a runtime error if
-an invalid character name is passed or there is an error changing the
-settings. The list of valid names is easily available via
-
- %cchars = GetControlChars();
- @cnames = keys %cchars;
-
-This call does nothing under Windows.
-
-=back
-
-=head1 AUTHOR
-
-Kenneth Albanowski <kjahds@kjahds.com>
-
-Currently maintained by Jonathan Stowe <jns@gellyfish.com>
-
-=cut
-
-package Term::ReadKey;
-
-$VERSION = '2.30';
-
-require Exporter;
-require AutoLoader;
-require DynaLoader;
-use Carp;
-
-@ISA = qw(Exporter AutoLoader DynaLoader);
-
-# Items to export into callers namespace by default
-# (move infrequently used names to @EXPORT_OK below)
-
-@EXPORT = qw(
- ReadKey
- ReadMode
- ReadLine
- GetTerminalSize
- SetTerminalSize
- GetSpeed
- GetControlChars
- SetControlChars
-);
-
-@EXPORT_OK = qw();
-
-bootstrap Term::ReadKey;
-
-# Preloaded methods go here. Autoload methods go after __END__, and are
-# processed by the autosplit program.
-
-# Should we use LINES and COLUMNS to try and get the terminal size?
-# Change this to zero if you have systems where these are commonly
-# set to erroneous values. (But if either are nero zero, they won't be
-# used anyhow.)
-
-$UseEnv = 1;
-
-%modes = (
- original => 0,
- restore => 0,
- normal => 1,
- noecho => 2,
- cbreak => 3,
- raw => 4,
- 'ultra-raw' => 5
-);
-
-sub ReadMode
-{
- my ($mode) = $modes{ $_[0] };
- my ($fh) = normalizehandle( ( @_ > 1 ? $_[1] : \*STDIN ) );
- if ( defined($mode) ) { SetReadMode( $mode, $fh ) }
- elsif ( $_[0] =~ /^\d/ ) { SetReadMode( $_[0], $fh ) }
- else { croak("Unknown terminal mode `$_[0]'"); }
-}
-
-sub normalizehandle
-{
- my ($file) = @_;
-
- # print "Handle = $file\n";
- if ( ref($file) ) { return $file; } # Reference is fine
-
- # if($file =~ /^\*/) { return $file; } # Type glob is good
- if ( ref( \$file ) eq 'GLOB' ) { return $file; } # Glob is good
-
- # print "Caller = ",(caller(1))[0],"\n";
- return \*{ ( ( caller(1) )[0] ) . "::$file" };
-}
-
-sub GetTerminalSize
-{
- my ($file) = normalizehandle( ( @_ > 1 ? $_[1] : \*STDOUT ) );
- my (@results) = ();
- my (@fail);
-
- if ( &termsizeoptions() & 1 ) # VIO
- {
- @results = GetTermSizeVIO($file);
- push( @fail, "VIOGetMode call" );
- }
- elsif ( &termsizeoptions() & 2 ) # GWINSZ
- {
- @results = GetTermSizeGWINSZ($file);
- push( @fail, "TIOCGWINSZ ioctl" );
- }
- elsif ( &termsizeoptions() & 4 ) # GSIZE
- {
- @results = GetTermSizeGSIZE($file);
- push( @fail, "TIOCGSIZE ioctl" );
- }
- elsif ( &termsizeoptions() & 8 ) # WIN32
- {
- @results = GetTermSizeWin32($file);
- push( @fail, "Win32 GetConsoleScreenBufferInfo call" );
- }
- else
- {
- @results = ();
- }
-
- if ( @results < 4 and $UseEnv )
- {
- my ($C) = defined( $ENV{COLUMNS} ) ? $ENV{COLUMNS} : 0;
- my ($L) = defined( $ENV{LINES} ) ? $ENV{LINES} : 0;
- if ( ( $C >= 2 ) and ( $L >= 2 ) )
- {
- @results = ( $C + 0, $L + 0, 0, 0 );
- }
- push( @fail, "COLUMNS and LINES environment variables" );
- }
-
- if ( @results < 4 )
- {
- my ($prog) = "resize";
-
- # Workaround for Solaris path sillyness
- if ( -f "/usr/openwin/bin/resize" ) {
- $prog = "/usr/openwin/bin/resize";
- }
-
- my ($resize) = scalar(`$prog 2>/dev/null`);
- if (
- defined $resize
- and ( $resize =~ /COLUMNS\s*=\s*(\d+)/
- or $resize =~ /setenv\s+COLUMNS\s+'?(\d+)/ )
- )
- {
- $results[0] = $1;
- if ( $resize =~ /LINES\s*=\s*(\d+)/
- or $resize =~ /setenv\s+LINES\s+'?(\d+)/ )
- {
- $results[1] = $1;
- @results[ 2, 3 ] = ( 0, 0 );
- }
- else
- {
- @results = ();
- }
- }
- else
- {
- @results = ();
- }
- push( @fail, "resize program" );
- }
-
- if ( @results < 4 )
- {
- die "Unable to get Terminal Size."
- . join( "", map( " The $_ didn't work.", @fail ) );
- }
-
- @results;
-}
-
-if ( &blockoptions() & 1 ) # Use nodelay
-{
- if ( &blockoptions() & 2 ) #poll
- {
- eval <<'DONE';
- sub ReadKey {
- my($File) = normalizehandle((@_>1?$_[1]:\*STDIN));
- if (defined $_[0] && $_[0] > 0) {
- if ($_[0]) {
- return undef if &pollfile($File,$_[0]) == 0;
- }
- }
- if (defined $_[0] && $_[0] < 0) {
- &setnodelay($File,1);
- }
- my ($value) = getc $File;
- if (defined $_[0] && $_[0] < 0) {
- &setnodelay($File,0);
- }
- $value;
- }
- sub ReadLine {
- my($File) = normalizehandle((@_>1?$_[1]:\*STDIN));
-
- if (defined $_[0] && $_[0] > 0) {
- if ($_[0]) {
- return undef if &pollfile($File,$_[0]) == 0;
- }
- }
- if (defined $_[0] && $_[0] < 0) {
- &setnodelay($File,1)
- };
- my ($value) = scalar(<$File>);
- if ( defined $_[0] && $_[0]<0 ) {
- &setnodelay($File,0)
- };
- $value;
- }
-DONE
- }
- elsif ( &blockoptions() & 4 ) #select
- {
- eval <<'DONE';
- sub ReadKey {
- my($File) = normalizehandle((@_>1?$_[1]:\*STDIN));
- if(defined $_[0] && $_[0]>0) {
- if($_[0]) {return undef if &selectfile($File,$_[0])==0}
- }
- if(defined $_[0] && $_[0]<0) {&setnodelay($File,1);}
- my($value) = getc $File;
- if(defined $_[0] && $_[0]<0) {&setnodelay($File,0);}
- $value;
- }
- sub ReadLine {
- my($File) = normalizehandle((@_>1?$_[1]:\*STDIN));
- if(defined $_[0] && $_[0]>0) {
- if($_[0]) {return undef if &selectfile($File,$_[0])==0}
- }
- if(defined $_[0] && $_[0]<0) {&setnodelay($File,1)};
- my($value)=scalar(<$File>);
- if(defined $_[0] && $_[0]<0) {&setnodelay($File,0)};
- $value;
- }
-DONE
- }
- else
- { #nothing
- eval <<'DONE';
- sub ReadKey {
- my($File) = normalizehandle((@_>1?$_[1]:\*STDIN));
- if(defined $_[0] && $_[0]>0) {
- # Nothing better seems to exist, so I just use time-of-day
- # to timeout the read. This isn't very exact, though.
- $starttime=time;
- $endtime=$starttime+$_[0];
- &setnodelay($File,1);
- my($value)=undef;
- while(time<$endtime) { # This won't catch wraparound!
- $value = getc $File;
- last if defined($value);
- }
- &setnodelay($File,0);
- return $value;
- }
- if(defined $_[0] && $_[0]<0) {&setnodelay($File,1);}
- my($value) = getc $File;
- if(defined $_[0] && $_[0]<0) {&setnodelay($File,0);}
- $value;
- }
- sub ReadLine {
- my($File) = normalizehandle((@_>1?$_[1]:\*STDIN));
- if(defined $_[0] && $_[0]>0) {
- # Nothing better seems to exist, so I just use time-of-day
- # to timeout the read. This isn't very exact, though.
- $starttime=time;
- $endtime=$starttime+$_[0];
- &setnodelay($File,1);
- my($value)=undef;
- while(time<$endtime) { # This won't catch wraparound!
- $value = scalar(<$File>);
- last if defined($value);
- }
- &setnodelay($File,0);
- return $value;
- }
- if(defined $_[0] && $_[0]<0) {&setnodelay($File,1)};
- my($value)=scalar(<$File>);
- if(defined $_[0] && $_[0]<0) {&setnodelay($File,0)};
- $value;
- }
-DONE
- }
-}
-elsif ( &blockoptions() & 2 ) # Use poll
-{
- eval <<'DONE';
- sub ReadKey {
- my($File) = normalizehandle((@_>1?$_[1]:\*STDIN));
- if(defined $_[0] && $_[0] != 0) {
- return undef if &pollfile($File,$_[0]) == 0
- }
- getc $File;
- }
- sub ReadLine {
- my($File) = normalizehandle((@_>1?$_[1]:\*STDIN));
- if(defined $_[0] && $_[0]!=0) {
- return undef if &pollfile($File,$_[0]) == 0;
- }
- scalar(<$File>);
- }
-DONE
-}
-elsif ( &blockoptions() & 4 ) # Use select
-{
- eval <<'DONE';
- sub ReadKey {
- my($File) = normalizehandle((@_>1?$_[1]:\*STDIN));
- if(defined $_[0] && $_[0] !=0 ) {
- return undef if &selectfile($File,$_[0])==0
- }
- getc $File;
- }
- sub ReadLine {
- my($File) = normalizehandle((@_>1?$_[1]:\*STDIN));
- if(defined $_[0] && $_[0] != 0) {
- return undef if &selectfile($File,$_[0]) == 0;
- }
- scalar(<$File>);
- }
-DONE
-}
-elsif ( &blockoptions() & 8 ) # Use Win32
-{
- eval <<'DONE';
- sub ReadKey {
- my($File) = normalizehandle((@_>1?$_[1]:\*STDIN));
- if ($_[0]) {
- Win32PeekChar($File, $_[0]);
- } else {
- getc $File;
- }
- #if ($_[0]!=0) {return undef if !Win32PeekChar($File, $_[0])};
- #getc $File;
- }
- sub ReadLine {
- my($File) = normalizehandle((@_>1?$_[1]:\*STDIN));
- #if ($_[0]!=0) {return undef if !Win32PeekChar($File, $_[0])};
- #scalar(<$File>);
- if($_[0])
- {croak("Non-blocking ReadLine is not supported on this architecture")}
- scalar(<$File>);
- }
-DONE
-}
-else
-{
- eval <<'DONE';
- sub ReadKey {
- my($File) = normalizehandle((@_>1?$_[1]:\*STDIN));
- if($_[0])
- {croak("Non-blocking ReadKey is not supported on this architecture")}
- getc $File;
- }
- sub ReadLine {
- my($File) = normalizehandle((@_>1?$_[1]:\*STDIN));
- if($_[0])
- {croak("Non-blocking ReadLine is not supported on this architecture")}
- scalar(<$File>);
- }
-DONE
-}
-
-package Term::ReadKey; # return to package ReadKey so AutoSplit is happy
-1;
-
-__END__;
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Term/ReadLine/Gnu.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Term/ReadLine/Gnu.pm
deleted file mode 100644
index 392211d9242..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Term/ReadLine/Gnu.pm
+++ /dev/null
@@ -1,1921 +0,0 @@
-#
-# Gnu.pm --- The GNU Readline/History Library wrapper module
-#
-# $Id: Gnu.pm,v 1.97 2008-02-07 23:12:23+09 hiroo Exp $
-#
-# Copyright (c) 2008 Hiroo Hayashi. All rights reserved.
-#
-# This program is free software; you can redistribute it and/or
-# modify it under the same terms as Perl itself.
-#
-# Some of documentation strings in this file are cited from the
-# GNU Readline/History Library Manual.
-
-package Term::ReadLine::Gnu;
-
-=head1 NAME
-
-Term::ReadLine::Gnu - Perl extension for the GNU Readline/History Library
-
-=head1 SYNOPSIS
-
- use Term::ReadLine;
- $term = new Term::ReadLine 'ProgramName';
- while ( defined ($_ = $term->readline('prompt>')) ) {
- ...
- }
-
-=head1 DESCRIPTION
-
-=head2 Overview
-
-This is an implementation of Term::ReadLine using the GNU
-Readline/History Library.
-
-For basic functions object oriented interface is provided. These are
-described in the section L<"Standard Methods"|"Standard Methods"> and
-L<"C<Term::ReadLine::Gnu> Functions"|"C<Term::ReadLine::Gnu> Functions">.
-
-This package also has the interface with the almost all functions and
-variables which are documented in the GNU Readline/History Library
-Manual. They are documented in the section
-L<"C<Term::ReadLine::Gnu> Functions"|"C<Term::ReadLine::Gnu> Functions">
-and
-L<"C<Term::ReadLine::Gnu> Variables"|"C<Term::ReadLine::Gnu> Variables">
-briefly. For more detail of the GNU Readline/History Library, see
-'GNU Readline Library Manual' and 'GNU History Library Manual'.
-
-The sample programs under C<eg/> directory and test programs under
-C<t/> directory in the C<Term::ReadLine::Gnu> distribution include
-many example of this module.
-
-=head2 Standard Methods
-
-These methods are standard methods defined by B<Term::ReadLine>.
-
-=cut
-
-use strict;
-use Carp;
-
-# This module can't be loaded directly.
-BEGIN {
- if (not defined $Term::ReadLine::VERSION) {
- croak <<END;
-It is invalid to load Term::ReadLine::Gnu directly. Please consult
-the Term::ReadLine documentation for more information.
-END
- }
-}
-
-{
- use Exporter ();
- use DynaLoader;
- use vars qw($VERSION @ISA @EXPORT_OK);
-
- $VERSION = '1.17';
-
- # Term::ReadLine::Gnu::AU makes a function in
- # `Term::ReadLine::Gnu::XS' as a method.
- # The namespace of Term::ReadLine::Gnu::AU is searched before ones
- # of other classes
- @ISA = qw(Term::ReadLine::Gnu::AU Term::ReadLine::Stub
- Exporter DynaLoader);
-
- @EXPORT_OK = qw(RL_PROMPT_START_IGNORE RL_PROMPT_END_IGNORE
- NO_MATCH SINGLE_MATCH MULT_MATCH
- ISFUNC ISKMAP ISMACR
- UNDO_DELETE UNDO_INSERT UNDO_BEGIN UNDO_END
- RL_STATE_NONE RL_STATE_INITIALIZING
- RL_STATE_INITIALIZED RL_STATE_TERMPREPPED
- RL_STATE_READCMD RL_STATE_METANEXT
- RL_STATE_DISPATCHING RL_STATE_MOREINPUT
- RL_STATE_ISEARCH RL_STATE_NSEARCH
- RL_STATE_SEARCH RL_STATE_NUMERICARG
- RL_STATE_MACROINPUT RL_STATE_MACRODEF
- RL_STATE_OVERWRITE RL_STATE_COMPLETING
- RL_STATE_SIGHANDLER RL_STATE_UNDOING
- RL_STATE_DONE);
-
- bootstrap Term::ReadLine::Gnu $VERSION; # DynaLoader
-}
-require Term::ReadLine::Gnu::XS;
-
-# Global Variables
-
-use vars qw(%Attribs %Features);
-
-# Each variable in the GNU Readline Library is tied to an entry of
-# this hash (%Attribs). By accessing the hash entry, you can read
-# and/or write the variable in the GNU Readline Library. See the
-# package definition of Term::ReadLine::Gnu::Var and following code
-# for more details.
-
-# Normal (non-tied) entries
-%Attribs = (
- MinLength => 1,
- do_expand => 0,
- completion_word => [],
- term_set => ['', '', '', ''],
- );
-%Features = (
- appname => 1, minline => 1, autohistory => 1,
- getHistory => 1, setHistory => 1, addHistory => 1,
- readHistory => 1, writeHistory => 1,
- preput => 1, attribs => 1, newTTY => 1,
- tkRunning => Term::ReadLine::Stub->Features->{'tkRunning'},
- ornaments => Term::ReadLine::Stub->Features->{'ornaments'},
- stiflehistory => 1,
- );
-
-sub Attribs { \%Attribs; }
-sub Features { \%Features; }
-
-#
-# GNU Readline/History Library constant definition
-# These are included in @EXPORT_OK.
-
-# I can define these variables in XS code to use the value defined in
-# readline.h, etc. But it needs some calling convention change and
-# will cause compatiblity problem. I hope the definition of these
-# constant value will not be changed.
-
-# for non-printing characters in prompt string
-sub RL_PROMPT_START_IGNORE { "\001"; }
-sub RL_PROMPT_END_IGNORE { "\002"; }
-
-# for rl_filename_quoting_function
-sub NO_MATCH { 0; }
-sub SINGLE_MATCH { 1; }
-sub MULT_MATCH { 2; }
-
-# for rl_generic_bind, rl_function_of_keyseq
-sub ISFUNC { 0; }
-sub ISKMAP { 1; }
-sub ISMACR { 2; }
-
-# for rl_add_undo
-sub UNDO_DELETE { 0; }
-sub UNDO_INSERT { 1; }
-sub UNDO_BEGIN { 2; }
-sub UNDO_END { 3; }
-
-# for rl_readline_state
-sub RL_STATE_NONE { 0x00000; } # no state; before first call
-sub RL_STATE_INITIALIZING { 0x00001; } # initializing
-sub RL_STATE_INITIALIZED { 0x00002; } # initialization done
-sub RL_STATE_TERMPREPPED { 0x00004; } # terminal is prepped
-sub RL_STATE_READCMD { 0x00008; } # reading a command key
-sub RL_STATE_METANEXT { 0x00010; } # reading input after ESC
-sub RL_STATE_DISPATCHING { 0x00020; } # dispatching to a command
-sub RL_STATE_MOREINPUT { 0x00040; } # reading more input in a command function
-sub RL_STATE_ISEARCH { 0x00080; } # doing incremental search
-sub RL_STATE_NSEARCH { 0x00100; } # doing non-inc search
-sub RL_STATE_SEARCH { 0x00200; } # doing a history search
-sub RL_STATE_NUMERICARG { 0x00400; } # reading numeric argument
-sub RL_STATE_MACROINPUT { 0x00800; } # getting input from a macro
-sub RL_STATE_MACRODEF { 0x01000; } # defining keyboard macro
-sub RL_STATE_OVERWRITE { 0x02000; } # overwrite mode
-sub RL_STATE_COMPLETING { 0x04000; } # doing completion
-sub RL_STATE_SIGHANDLER { 0x08000; } # in readline sighandler
-sub RL_STATE_UNDOING { 0x10000; } # doing an undo
-sub RL_STATE_DONE { 0x80000; } # done; accepted line
-
-#
-# Methods Definition
-#
-
-=over 4
-
-=item C<ReadLine>
-
-returns the actual package that executes the commands. If you have
-installed this package, possible value is C<Term::ReadLine::Gnu>.
-
-=cut
-
-sub ReadLine { 'Term::ReadLine::Gnu'; }
-
-=item C<new(NAME,[IN[,OUT]])>
-
-returns the handle for subsequent calls to following functions.
-Argument is the name of the application. Optionally can be followed
-by two arguments for C<IN> and C<OUT> file handles. These arguments
-should be globs.
-
-=cut
-
-# The origin of this function is Term::ReadLine::Perl.pm by Ilya Zakharevich.
-sub new {
- my $this = shift; # Package
- my $class = ref($this) || $this;
-
- my $name = shift;
-
- my $self = \%Attribs;
- bless $self, $class;
-
- # set rl_readline_name before .inputrc is read in rl_initialize()
- $Attribs{readline_name} = $name;
-
- # some version of Perl cause segmentation fault, if XS module
- # calls setenv() before the 1st assignment to $ENV{}.
- $ENV{_TRL_DUMMY} = '';
-
- # initialize the GNU Readline Library and termcap library
- $self->initialize();
-
- # enable ornaments to be compatible with perl5.004_05(?)
- unless ($ENV{PERL_RL} and $ENV{PERL_RL} =~ /\bo\w*=0/) {
- local $^W = 0; # Term::ReadLine is not warning flag free
- # Without the next line Term::ReadLine::Stub::ornaments is used.
- # Why does Term::ReadLine::Gnu::AU selects it at first?!!!
- # If you know why this happens, please let me know. Thanks.
- undef &Term::ReadLine::Gnu::ornaments;
- $self->ornaments(1);
- }
-
- if (!@_) {
- my ($IN,$OUT) = $self->findConsole();
- open(IN,"<$IN") || croak "Cannot open $IN for read";
- open(OUT,">$OUT") || croak "Cannot open $OUT for write";
- # borrowed from Term/ReadLine.pm
- my $sel = select(OUT);
- $| = 1; # for DB::OUT
- select($sel);
- $Attribs{instream} = \*IN;
- $Attribs{outstream} = \*OUT;
- } else {
- $Attribs{instream} = shift;
- $Attribs{outstream} = shift;
- }
-
- $self;
-}
-
-sub DESTROY {}
-
-=item C<readline(PROMPT[,PREPUT])>
-
-gets an input line, with actual C<GNU Readline> support. Trailing
-newline is removed. Returns C<undef> on C<EOF>. C<PREPUT> is an
-optional argument meaning the initial value of input.
-
-The optional argument C<PREPUT> is granted only if the value C<preput>
-is in C<Features>.
-
-C<PROMPT> may include some escape sequences. Use
-C<RL_PROMPT_START_IGNORE> to begin a sequence of non-printing
-characters, and C<RL_PROMPT_END_IGNORE> to end of such a sequence.
-
-=cut
-
-# to peacify -w
-$Term::ReadLine::registered = $Term::ReadLine::registered;
-
-sub readline { # should be ReadLine
- my $self = shift;
- my ($prompt, $preput) = @_;
-
- # ornament support (now prompt only)
- $prompt = ${$Attribs{term_set}}[0] . $prompt . ${$Attribs{term_set}}[1];
-
- # `completion_function' support for compatibility with
- # Term:ReadLine::Perl. Prefer $completion_entry_function, since a
- # program which uses $completion_entry_function should know
- # Term::ReadLine::Gnu and have better completion function using
- # the variable.
- $Attribs{completion_entry_function} = $Attribs{_trp_completion_function}
- if (!defined $Attribs{completion_entry_function}
- && defined $Attribs{completion_function});
-
- # TkRunning support
- if (not $Term::ReadLine::registered and $Term::ReadLine::toloop
- and defined &Tk::DoOneEvent) {
- $self->register_Tk;
- $Attribs{getc_function} = $Attribs{Tk_getc};
- }
-
- # call readline()
- my $line;
- if (defined $preput) {
- my $saved_startup_hook = $Attribs{startup_hook};
- $Attribs{startup_hook} = sub {
- $self->rl_insert_text($preput);
- &$saved_startup_hook
- if defined $saved_startup_hook;
- };
- $line = $self->rl_readline($prompt);
- $Attribs{startup_hook} = $saved_startup_hook;
- } else {
- $line = $self->rl_readline($prompt);
- }
- return undef unless defined $line;
-
- # history expansion
- if ($Attribs{do_expand}) {
- my $result;
- ($result, $line) = $self->history_expand($line);
- my $outstream = $Attribs{outstream};
- print $outstream "$line\n" if ($result);
-
- # return without adding line into history
- if ($result < 0 || $result == 2) {
- return ''; # don't return `undef' which means EOF.
- }
- }
-
- # add to history buffer
- $self->add_history($line)
- if (defined $self->{MinLength} && $self->{MinLength} > 0
- && length($line) >= $self->{MinLength});
-
- return $line;
-}
-
-=item C<AddHistory(LINE1, LINE2, ...)>
-
-adds the lines to the history of input, from where it can be used if
-the actual C<readline> is present.
-
-=cut
-
-use vars '*addhistory';
-*addhistory = \&AddHistory; # for backward compatibility
-
-sub AddHistory {
- my $self = shift;
- foreach (@_) {
- $self->add_history($_);
- }
-}
-
-=item C<IN>, C<OUT>
-
-return the file handles for input and output or C<undef> if
-C<readline> input and output cannot be used for Perl.
-
-=cut
-
-sub IN { $Attribs{instream}; }
-sub OUT { $Attribs{outstream}; }
-
-=item C<MinLine([MAX])>
-
-If argument C<MAX> is specified, it is an advice on minimal size of
-line to be included into history. C<undef> means do not include
-anything into history. Returns the old value.
-
-=cut
-
-sub MinLine {
- my $self = shift;
- my $old_minlength = $self->{MinLength};
- $self->{MinLength} = shift;
- $old_minlength;
-}
-
-# findConsole is defined in ReadLine.pm.
-
-=item C<findConsole>
-
-returns an array with two strings that give most appropriate names for
-files for input and output using conventions C<"E<lt>$in">, C<"E<gt>$out">.
-
-=item C<Attribs>
-
-returns a reference to a hash which describes internal configuration
-(variables) of the package. Names of keys in this hash conform to
-standard conventions with the leading C<rl_> stripped.
-
-See section "Variables" for supported variables.
-
-=item C<Features>
-
-Returns a reference to a hash with keys being features present in
-current implementation. Several optional features are used in the
-minimal interface: C<appname> should be present if the first argument
-to C<new> is recognized, and C<minline> should be present if
-C<MinLine> method is not dummy. C<autohistory> should be present if
-lines are put into history automatically (maybe subject to
-C<MinLine>), and C<addHistory> if C<AddHistory> method is not dummy.
-C<preput> means the second argument to C<readline> method is processed.
-C<getHistory> and C<setHistory> denote that the corresponding methods are
-present. C<tkRunning> denotes that a Tk application may run while ReadLine
-is getting input.
-
-=cut
-
-# Not tested yet. How do I use this?
-sub newTTY {
- my ($self, $in, $out) = @_;
- $Attribs{instream} = $in;
- $Attribs{outstream} = $out;
- my $sel = select($out);
- $| = 1; # for DB::OUT
- select($sel);
-}
-
-=back
-
-=cut
-
-# documented later
-sub CallbackHandlerInstall {
- my $self = shift;
- my ($prompt, $lhandler) = @_;
-
- $Attribs{_callback_handler} = $lhandler;
-
- # ornament support (now prompt only)
- $prompt = ${$Attribs{term_set}}[0] . $prompt . ${$Attribs{term_set}}[1];
-
- $Attribs{completion_entry_function} = $Attribs{_trp_completion_function}
- if (!defined $Attribs{completion_entry_function}
- && defined $Attribs{completion_function});
-
- $self->rl_callback_handler_install($prompt,
- \&Term::ReadLine::Gnu::XS::_ch_wrapper);
-}
-
-
-#
-# Additional Supported Methods
-#
-
-# Documentation is after '__END__' for efficiency.
-
-# for backward compatibility
-use vars qw(*AddDefun *BindKey *UnbindKey *ParseAndBind *StifleHistory);
-*AddDefun = \&add_defun;
-*BindKey = \&bind_key;
-*UnbindKey = \&unbind_key;
-*ParseAndBind = \&parse_and_bind;
-*StifleHistory = \&stifle_history;
-
-sub SetHistory {
- my $self = shift;
- $self->clear_history();
- $self->AddHistory(@_);
-}
-
-sub GetHistory {
- my $self = shift;
- $self->history_list();
-}
-
-sub ReadHistory {
- my $self = shift;
- ! $self->read_history_range(@_);
-}
-
-sub WriteHistory {
- my $self = shift;
- ! $self->write_history(@_);
-}
-
-#
-# Access Routines for GNU Readline/History Library Variables
-#
-package Term::ReadLine::Gnu::Var;
-use Carp;
-use strict;
-use vars qw(%_rl_vars);
-
-%_rl_vars
- = (
- rl_line_buffer => ['S', 0],
- rl_prompt => ['S', 1],
- rl_library_version => ['S', 2],
- rl_terminal_name => ['S', 3],
- rl_readline_name => ['S', 4],
- rl_basic_word_break_characters => ['S', 5],
- rl_basic_quote_characters => ['S', 6],
- rl_completer_word_break_characters => ['S', 7],
- rl_completer_quote_characters => ['S', 8],
- rl_filename_quote_characters => ['S', 9],
- rl_special_prefixes => ['S', 10],
- history_no_expand_chars => ['S', 11],
- history_search_delimiter_chars => ['S', 12],
- rl_executing_macro => ['S', 13], # GRL4.2
- history_word_delimiters => ['S', 14], # GRL4.2
-
- rl_point => ['I', 0],
- rl_end => ['I', 1],
- rl_mark => ['I', 2],
- rl_done => ['I', 3],
- rl_pending_input => ['I', 4],
- rl_completion_query_items => ['I', 5],
- rl_completion_append_character => ['C', 6],
- rl_ignore_completion_duplicates => ['I', 7],
- rl_filename_completion_desired => ['I', 8],
- rl_filename_quoting_desired => ['I', 9],
- rl_inhibit_completion => ['I', 10],
- history_base => ['I', 11],
- history_length => ['I', 12],
- history_max_entries => ['I', 13],
- max_input_history => ['I', 13], # before GRL 4.2
- history_write_timestamps => ['I', 14], # GRL 5.0
- history_expansion_char => ['C', 15],
- history_subst_char => ['C', 16],
- history_comment_char => ['C', 17],
- history_quotes_inhibit_expansion => ['I', 18],
- rl_erase_empty_line => ['I', 19], # GRL 4.0
- rl_catch_signals => ['I', 20], # GRL 4.0
- rl_catch_sigwinch => ['I', 21], # GRL 4.0
- rl_already_prompted => ['I', 22], # GRL 4.1
- rl_num_chars_to_read => ['I', 23], # GRL 4.2
- rl_dispatching => ['I', 24], # GRL 4.2
- rl_gnu_readline_p => ['I', 25], # GRL 4.2
- rl_readline_state => ['I', 26], # GRL 4.2
- rl_explicit_arg => ['I', 27], # GRL 4.2
- rl_numeric_arg => ['I', 28], # GRL 4.2
- rl_editing_mode => ['I', 29], # GRL 4.2
- rl_attempted_completion_over => ['I', 30], # GRL 4.2
- rl_completion_type => ['I', 31], # GRL 4.2
- rl_readline_version => ['I', 32], # GRL 4.2a
- rl_completion_suppress_append => ['I', 33], # GRL 4.3
- rl_completion_quote_character => ['C', 34], # GRL 5.0
- rl_completion_suppress_quote => ['I', 35], # GRL 5.0
- rl_completion_found_quote => ['I', 36], # GRL 5.0
- rl_completion_mark_symlink_dirs => ['I', 37], # GRL 4.3
- rl_prefer_env_winsize => ['I', 38], # GRL 5.1
-
- rl_startup_hook => ['F', 0],
- rl_event_hook => ['F', 1],
- rl_getc_function => ['F', 2],
- rl_redisplay_function => ['F', 3],
- rl_completion_entry_function => ['F', 4],
- rl_attempted_completion_function => ['F', 5],
- rl_filename_quoting_function => ['F', 6],
- rl_filename_dequoting_function => ['F', 7],
- rl_char_is_quoted_p => ['F', 8],
- rl_ignore_some_completions_function => ['F', 9],
- rl_directory_completion_hook => ['F', 10],
- history_inhibit_expansion_function => ['F', 11],
- rl_pre_input_hook => ['F', 12], # GRL 4.0
- rl_completion_display_matches_hook => ['F', 13], # GRL 4.0
- rl_completion_word_break_hook => ['F', 14], # GRL 5.0
- rl_prep_term_function => ['F', 15], # GRL 4.2
- rl_deprep_term_function => ['F', 16], # GRL 4.2
-
- rl_instream => ['IO', 0],
- rl_outstream => ['IO', 1],
-
- rl_executing_keymap => ['K', 0],
- rl_binding_keymap => ['K', 1],
-
- rl_last_func => ['LF', 0],
- );
-
-sub TIESCALAR {
- my $class = shift;
- my $name = shift;
- return bless \$name, $class;
-}
-
-sub FETCH {
- my $self = shift;
- confess "wrong type" unless ref $self;
-
- my $name = $$self;
- if (! defined $_rl_vars{$name}) {
- confess "Term::ReadLine::Gnu::Var::FETCH: Unknown variable name `$name'\n";
- return undef ;
- }
-
- my ($type, $id) = @{$_rl_vars{$name}};
- if ($type eq 'S') {
- return _rl_fetch_str($id);
- } elsif ($type eq 'I') {
- return _rl_fetch_int($id);
- } elsif ($type eq 'C') {
- return chr(_rl_fetch_int($id));
- } elsif ($type eq 'F') {
- return _rl_fetch_function($id);
- } elsif ($type eq 'IO') {
- return _rl_fetch_iostream($id);
- } elsif ($type eq 'K') {
- return _rl_fetch_keymap($id);
- } elsif ($type eq 'LF') {
- return _rl_fetch_last_func();
- } else {
- carp "Term::ReadLine::Gnu::Var::FETCH: Illegal type `$type'\n";
- return undef;
- }
-}
-
-sub STORE {
- my $self = shift;
- confess "wrong type" unless ref $self;
-
- my $name = $$self;
- if (! defined $_rl_vars{$name}) {
- confess "Term::ReadLine::Gnu::Var::STORE: Unknown variable name `$name'\n";
- return undef ;
- }
-
- my $value = shift;
- my ($type, $id) = @{$_rl_vars{$name}};
- if ($type eq 'S') {
- if ($name eq 'rl_line_buffer') {
- return _rl_store_rl_line_buffer($value);
- } else {
- return _rl_store_str($value, $id);
- }
- } elsif ($type eq 'I') {
- return _rl_store_int($value, $id);
- } elsif ($type eq 'C') {
- return chr(_rl_store_int(ord($value), $id));
- } elsif ($type eq 'F') {
- return _rl_store_function($value, $id);
- } elsif ($type eq 'IO') {
- return _rl_store_iostream($value, $id);
- } elsif ($type eq 'K' || $type eq 'LF') {
- carp "Term::ReadLine::Gnu::Var::STORE: read only variable `$name'\n";
- return undef;
- } else {
- carp "Term::ReadLine::Gnu::Var::STORE: Illegal type `$type'\n";
- return undef;
- }
-}
-
-package Term::ReadLine::Gnu;
-use Carp;
-use strict;
-
-#
-# set value of %Attribs
-#
-
-# Tie all Readline/History variables
-foreach (keys %Term::ReadLine::Gnu::Var::_rl_vars) {
- my $name;
- ($name = $_) =~ s/^rl_//; # strip leading `rl_'
- tie $Attribs{$name}, 'Term::ReadLine::Gnu::Var', $_;
-}
-
-# add reference to some functions
-{
- my ($name, $fname);
- no strict 'refs'; # allow symbolic reference
- map {
- ($name = $_) =~ s/^rl_//; # strip leading `rl_'
- $fname = 'Term::ReadLine::Gnu::XS::' . $_;
- $Attribs{$name} = \&$fname; # symbolic reference
- } qw(rl_getc
- rl_redisplay
- rl_callback_read_char
- rl_display_match_list
- rl_filename_completion_function
- rl_username_completion_function
- list_completion_function
- _trp_completion_function);
- # auto-split subroutine cannot be processed in the map loop above
- use strict 'refs';
- $Attribs{shadow_redisplay} = \&Term::ReadLine::Gnu::XS::shadow_redisplay;
- $Attribs{Tk_getc} = \&Term::ReadLine::Gnu::XS::Tk_getc;
- $Attribs{list_completion_function} = \&Term::ReadLine::Gnu::XS::list_completion_function;
-}
-
-package Term::ReadLine::Gnu::AU;
-use Carp;
-no strict qw(refs vars);
-
-sub AUTOLOAD {
- { $AUTOLOAD =~ s/.*:://; } # preserve match data
- my $name;
- if (exists $Term::ReadLine::Gnu::XS::{"rl_$AUTOLOAD"}) {
- $name = "Term::ReadLine::Gnu::XS::rl_$AUTOLOAD";
- } elsif (exists $Term::ReadLine::Gnu::XS::{"$AUTOLOAD"}) {
- $name = "Term::ReadLine::Gnu::XS::$AUTOLOAD";
- } else {
- croak "Cannot do `$AUTOLOAD' in Term::ReadLine::Gnu";
- }
- local $^W = 0; # Why is this line necessary ?
- *$AUTOLOAD = sub { shift; &$name(@_); };
- goto &$AUTOLOAD;
-}
-1;
-__END__
-
-
-=head2 C<Term::ReadLine::Gnu> Functions
-
-All these GNU Readline/History Library functions are callable via
-method interface and have names which conform to standard conventions
-with the leading C<rl_> stripped.
-
-Almost methods have lower level functions in
-C<Term::ReadLine::Gnu::XS> package. To use them full qualified name
-is required. Using method interface is preferred.
-
-=over 4
-
-=item Readline Convenience Functions
-
-=over 4
-
-=item Naming Function
-
-=over 4
-
-=item C<add_defun(NAME, FUNC [,KEY=-1])>
-
-Add name to the Perl function C<FUNC>. If optional argument C<KEY> is
-specified, bind it to the C<FUNC>. Returns reference to
-C<FunctionPtr>.
-
- Example:
- # name name `reverse-line' to a function reverse_line(),
- # and bind it to "\C-t"
- $term->add_defun('reverse-line', \&reverse_line, ord "\ct");
-
-=back
-
-=item Selecting a Keymap
-
-=over 4
-
-=item C<make_bare_keymap>
-
- Keymap rl_make_bare_keymap()
-
-=item C<copy_keymap(MAP)>
-
- Keymap rl_copy_keymap(Keymap|str map)
-
-=item C<make_keymap>
-
- Keymap rl_make_keymap()
-
-=item C<discard_keymap(MAP)>
-
- Keymap rl_discard_keymap(Keymap|str map)
-
-=item C<get_keymap>
-
- Keymap rl_get_keymap()
-
-=item C<set_keymap(MAP)>
-
- Keymap rl_set_keymap(Keymap|str map)
-
-=item C<get_keymap_by_name(NAME)>
-
- Keymap rl_get_keymap_by_name(str name)
-
-=item C<get_keymap_name(MAP)>
-
- str rl_get_keymap_name(Keymap map)
-
-=back
-
-=item Binding Keys
-
-=over 4
-
-=item C<bind_key(KEY, FUNCTION [,MAP])>
-
- int rl_bind_key(int key, FunctionPtr|str function,
- Keymap|str map = rl_get_keymap())
-
-Bind C<KEY> to the C<FUNCTION>. C<FUNCTION> is the name added by the
-C<add_defun> method. If optional argument C<MAP> is specified, binds
-in C<MAP>. Returns non-zero in case of error.
-
-=item C<bind_key_if_unbound(KEY, FUNCTION [,MAP])>
-
- int rl_bind_key_if_unbound(int key, FunctionPtr|str function,
- Keymap|str map = rl_get_keymap()) #GRL5.0
-
-=item C<unbind_key(KEY [,MAP])>
-
- int rl_unbind_key(int key, Keymap|str map = rl_get_keymap())
-
-Bind C<KEY> to the null function. Returns non-zero in case of error.
-
-=item C<unbind_function(FUNCTION [,MAP])>
-
- int rl_unbind_function(FunctionPtr|str function,
- Keymap|str map = rl_get_keymap())
-
-=item C<unbind_command(COMMAND [,MAP])>
-
- int rl_unbind_command(str command,
- Keymap|str map = rl_get_keymap())
-
-=item C<bind_keyseq(KEYSEQ, FUNCTION [,MAP])>
-
- int rl_bind_keyseq(str keyseq, FunctionPtr|str function,
- Keymap|str map = rl_get_keymap()) # GRL 5.0
-
-=item C<set_key(KEYSEQ, FUNCTION [,MAP])>
-
- int rl_set_key(str keyseq, FunctionPtr|str function,
- Keymap|str map = rl_get_keymap())
-
-=item C<bind_keyseq_if_unbound(KEYSEQ, FUNCTION [,MAP])>
-
- int rl_bind_keyseq_if_unbound(str keyseq, FunctionPtr|str function,
- Keymap|str map = rl_get_keymap()) # GRL 5.0
-
-=item C<generic_bind(TYPE, KEYSEQ, DATA, [,MAP])>
-
- int rl_generic_bind(int type, str keyseq,
- FunctionPtr|Keymap|str data,
- Keymap|str map = rl_get_keymap())
-
-=item C<parse_and_bind(LINE)>
-
- void rl_parse_and_bind(str line)
-
-Parse C<LINE> as if it had been read from the F<~/.inputrc> file and
-perform any key bindings and variable assignments found. For more
-detail see 'GNU Readline Library Manual'.
-
-=item C<read_init_file([FILENAME])>
-
- int rl_read_init_file(str filename = '~/.inputrc')
-
-=back
-
-=item Associating Function Names and Bindings
-
-=over 4
-
-=item C<named_function(NAME)>
-
- FunctionPtr rl_named_function(str name)
-
-=item C<get_function_name(FUNCTION)>
-
- str rl_get_function_name(FunctionPtr function)
-
-=item C<function_of_keyseq(KEYMAP [,MAP])>
-
- (FunctionPtr|Keymap|str data, int type)
- rl_function_of_keyseq(str keyseq,
- Keymap|str map = rl_get_keymap())
-
-=item C<invoking_keyseqs(FUNCTION [,MAP])>
-
- (@str) rl_invoking_keyseqs(FunctionPtr|str function,
- Keymap|str map = rl_get_keymap())
-
-=item C<function_dumper([READABLE])>
-
- void rl_function_dumper(int readable = 0)
-
-=item C<list_funmap_names>
-
- void rl_list_funmap_names()
-
-=item C<funmap_names>
-
- (@str) rl_funmap_names()
-
-=item C<add_funmap_entry(NAME, FUNCTION)>
-
- int rl_add_funmap_entry(char *name, FunctionPtr|str function)
-
-=back
-
-=item Allowing Undoing
-
-=over 4
-
-=item C<begin_undo_group>
-
- int rl_begin_undo_group()
-
-=item C<end_undo_group>
-
- int rl_end_undo_group()
-
-=item C<add_undo(WHAT, START, END, TEXT)>
-
- int rl_add_undo(int what, int start, int end, str text)
-
-=item C<free_undo_list>
-
- void rl_free_undo_list()
-
-=item C<do_undo>
-
- int rl_do_undo()
-
-=item C<modifying([START [,END]])>
-
- int rl_modifying(int start = 0, int end = rl_end)
-
-=back
-
-=item Redisplay
-
-=over 4
-
-=item C<redisplay>
-
- void rl_redisplay()
-
-=item C<forced_update_display>
-
- int rl_forced_update_display()
-
-=item C<on_new_line>
-
- int rl_on_new_line()
-
-=item C<on_new_line_with_prompt>
-
- int rl_on_new_line_with_prompt() # GRL 4.1
-
-=item C<reset_line_state>
-
- int rl_reset_line_state()
-
-=item C<rl_show_char(C)>
-
- int rl_show_char(int c)
-
-=item C<message(FMT[, ...])>
-
- int rl_message(str fmt, ...)
-
-=item C<crlf>
-
- int rl_crlf() # GRL 4.2
-
-=item C<clear_message>
-
- int rl_clear_message()
-
-=item C<save_prompt>
-
- void rl_save_prompt()
-
-=item C<restore_prompt>
-
- void rl_restore_prompt()
-
-=item C<expand_prompt(PROMPT)>
-
- int rl_expand_prompt(str prompt) # GRL 4.2
-
-=item C<set_prompt(PROMPT)>
-
- int rl_set_prompt(const str prompt) # GRL 4.2
-
-=back
-
-=item Modifying Text
-
-=over 4
-
-=item C<insert_text(TEXT)>
-
- int rl_insert_text(str text)
-
-=item C<delete_text([START [,END]])>
-
- int rl_delete_text(int start = 0, int end = rl_end)
-
-=item C<copy_text([START [,END]])>
-
- str rl_copy_text(int start = 0, int end = rl_end)
-
-=item C<kill_text([START [,END]])>
-
- int rl_kill_text(int start = 0, int end = rl_end)
-
-=item C<push_macro_input(MACRO)>
-
- int rl_push_macro_input(str macro)
-
-=back
-
-=item Character Input
-
-=over 4
-
-=item C<read_key>
-
- int rl_read_key()
-
-=item C<getc(STREAM)>
-
- int rl_getc(FILE *STREAM)
-
-=item C<stuff_char(C)>
-
- int rl_stuff_char(int c)
-
-=item C<execute_next(C)>
-
- int rl_execute_next(int c) # GRL 4.2
-
-=item C<clear_pending_input()>
-
- int rl_clear_pending_input() # GRL 4.2
-
-=item C<set_keyboard_input_timeout(uSEC)>
-
- int rl_set_keyboard_input_timeout(int usec) # GRL 4.2
-
-=back
-
-=item Terminal Management
-
-=over 4
-
-=item C<prep_terminal(META_FLAG)>
-
- void rl_prep_terminal(int META_FLAG) # GRL 4.2
-
-=item C<deprep_terminal()>
-
- void rl_deprep_terminal() # GRL 4.2
-
-=item C<tty_set_default_bindings(KMAP)>
-
- void rl_tty_set_default_bindings([Keymap KMAP]) # GRL 4.2
-
-=item C<tty_unset_default_bindings(KMAP)>
-
- void rl_tty_unset_default_bindings([Keymap KMAP]) # GRL 5.0
-
-=item C<reset_terminal([TERMINAL_NAME])>
-
- int rl_reset_terminal(str terminal_name = getenv($TERM)) # GRL 4.2
-
-=back
-
-=item Utility Functions
-
-=over 4
-
-=item C<replace_line(TEXT [,CLEAR_UNDO]>
-
- int rl_replace_line(str text, int clear_undo) # GRL 4.3
-
-=item C<initialize>
-
- int rl_initialize()
-
-=item C<ding>
-
- int rl_ding()
-
-=item C<alphabetic(C)>
-
- int rl_alphabetic(int C)
-
-=item C<display_match_list(MATCHES [,LEN [,MAX]])>
-
- void rl_display_match_list(\@matches, len = $#maches, max) # GRL 4.0
-
-Since the first element of an array @matches as treated as a possible
-completion, it is not displayed. See the descriptions of
-C<completion_matches()>.
-
-When C<MAX> is ommited, the max length of an item in @matches is used.
-
-=back
-
-=item Miscellaneous Functions
-
-=over 4
-
-=item C<macro_bind(KEYSEQ, MACRO [,MAP])>
-
- int rl_macro_bind(const str keyseq, const str macro, Keymap map)
-
-=item C<macro_dumper(READABLE)>
-
- int rl_macro_dumper(int readline)
-
-=item C<variable_bind(VARIABLE, VALUE)>
-
- int rl_variable_bind(const str variable, const str value)
-
-=item C<variable_value(VARIABLE)>
-
- str rl_variable_value(const str variable) # GRL 5.1
-
-=item C<variable_dumper(READABLE)>
-
- int rl_variable_dumper(int readline)
-
-=item C<set_paren_blink_timeout(uSEC)>
-
- int rl_set_paren_blink_timeout(usec) # GRL 4.2
-
-=item C<get_termcap(cap)>
-
- str rl_get_termcap(cap)
-
-=back
-
-=item Alternate Interface
-
-=over 4
-
-=item C<callback_handler_install(PROMPT, LHANDLER)>
-
- void rl_callback_handler_install(str prompt, pfunc lhandler)
-
-=item C<callback_read_char>
-
- void rl_callback_read_char()
-
-=item C<callback_handler_remove>
-
- void rl_callback_handler_remove()
-
-=back
-
-=back
-
-=item Readline Signal Handling
-
-=over 4
-
-=item C<cleanup_after_signal>
-
- void rl_cleanup_after_signal() # GRL 4.0
-
-=item C<free_line_state>
-
- void rl_free_line_state() # GRL 4.0
-
-=item C<reset_after_signal>
-
- void rl_reset_after_signal() # GRL 4.0
-
-=item C<resize_terminal>
-
- void rl_resize_terminal() # GRL 4.0
-
-=item C<set_screen_size(ROWS, COLS)>
-
- void rl_set_screen_size(int ROWS, int COLS) # GRL 4.2
-
-=item C<get_screen_size()>
-
- (int rows, int cols) rl_get_screen_size() # GRL 4.2
-
-=item C<reset_screen_size()>
-
- void rl_reset_screen_size() # GRL 5.1
-
-=item C<set_signals>
-
- int rl_set_signals() # GRL 4.0
-
-=item C<clear_signals>
-
- int rl_clear_signals() # GRL 4.0
-
-=back
-
-=item Completion Functions
-
-=over 4
-
-=item C<complete_internal([WHAT_TO_DO])>
-
- int rl_complete_internal(int what_to_do = TAB)
-
-=item C<completion_mode(FUNCTION)>
-
- int rl_completion_mode(FunctionPtr|str function)
-
-=item C<completion_matches(TEXT [,FUNC])>
-
- (@str) rl_completion_matches(str text,
- pfunc func = filename_completion_function)
-
-=item C<filename_completion_function(TEXT, STATE)>
-
- str rl_filename_completion_function(str text, int state)
-
-=item C<username_completion_function(TEXT, STATE)>
-
- str rl_username_completion_function(str text, int state)
-
-=item C<list_completion_function(TEXT, STATE)>
-
- str list_completion_function(str text, int state)
-
-=back
-
-=item History Functions
-
-=over 4
-
-=item Initializing History and State Management
-
-=over 4
-
-=item C<using_history>
-
- void using_history()
-
-=back
-
-=item History List Management
-
-=over 4
-
-=item C<addhistory(STRING[, STRING, ...])>
-
- void add_history(str string)
-
-=item C<StifleHistory(MAX)>
-
- int stifle_history(int max|undef)
-
-stifles the history list, remembering only the last C<MAX> entries.
-If C<MAX> is undef, remembers all entries. This is a replacement
-of unstifle_history().
-
-=item C<unstifle_history>
-
- int unstifle_history()
-
-This is equivalent with 'stifle_history(undef)'.
-
-=item C<SetHistory(LINE1 [, LINE2, ...])>
-
-sets the history of input, from where it can be used if the actual
-C<readline> is present.
-
-=item C<add_history_time(STRING)>
-
- void add_history_time(str string) # GRL 5.0
-
-=item C<remove_history(WHICH)>
-
- str remove_history(int which)
-
-=item C<replace_history_entry(WHICH, LINE)>
-
- str replace_history_entry(int which, str line)
-
-=item C<clear_history>
-
- void clear_history()
-
-=item C<history_is_stifled>
-
- int history_is_stifled()
-
-=back
-
-=item Information About the History List
-
-=over 4
-
-=item C<where_history>
-
- int where_history()
-
-=item C<current_history>
-
- str current_history()
-
-=item C<history_get(OFFSET)>
-
- str history_get(offset)
-
-=item C<history_get_time(OFFSET)>
-
- time_t history_get_time(offset)
-
-=item C<history_total_bytes>
-
- int history_total_bytes()
-
-=item C<GetHistory>
-
-returns the history of input as a list, if actual C<readline> is present.
-
-=back
-
-=item Moving Around the History List
-
-=over 4
-
-=item C<history_set_pos(POS)>
-
- int history_set_pos(int pos)
-
-=item C<previous_history>
-
- str previous_history()
-
-=item C<next_history>
-
- str next_history()
-
-=back
-
-=item Searching the History List
-
-=over 4
-
-=item C<history_search(STRING [,DIRECTION])>
-
- int history_search(str string, int direction = -1)
-
-=item C<history_search_prefix(STRING [,DIRECTION])>
-
- int history_search_prefix(str string, int direction = -1)
-
-=item C<history_search_pos(STRING [,DIRECTION [,POS]])>
-
- int history_search_pos(str string,
- int direction = -1,
- int pos = where_history())
-
-=back
-
-=item Managing the History File
-
-=over 4
-
-=item C<ReadHistory([FILENAME [,FROM [,TO]]])>
-
- int read_history(str filename = '~/.history',
- int from = 0, int to = -1)
-
- int read_history_range(str filename = '~/.history',
- int from = 0, int to = -1)
-
-adds the contents of C<FILENAME> to the history list, a line at a
-time. If C<FILENAME> is false, then read from F<~/.history>. Start
-reading at line C<FROM> and end at C<TO>. If C<FROM> is omitted or
-zero, start at the beginning. If C<TO> is omitted or less than
-C<FROM>, then read until the end of the file. Returns true if
-successful, or false if not. C<read_history()> is an aliase of
-C<read_history_range()>.
-
-=item C<WriteHistory([FILENAME])>
-
- int write_history(str filename = '~/.history')
-
-writes the current history to C<FILENAME>, overwriting C<FILENAME> if
-necessary. If C<FILENAME> is false, then write the history list to
-F<~/.history>. Returns true if successful, or false if not.
-
-
-=item C<append_history(NELEMENTS [,FILENAME])>
-
- int append_history(int nelements, str filename = '~/.history')
-
-=item C<history_truncate_file([FILENAME [,NLINES]])>
-
- int history_truncate_file(str filename = '~/.history',
- int nlines = 0)
-
-=back
-
-=item History Expansion
-
-=over 4
-
-=item C<history_expand(LINE)>
-
- (int result, str expansion) history_expand(str line)
-
-Note that this function returns C<expansion> in scalar context.
-
-=item C<get_history_event(STRING, CINDEX [,QCHAR])>
-
- (str text, int cindex) = get_history_event(str string,
- int cindex,
- char qchar = '\0')
-
-=item C<history_tokenize(LINE)>
-
- (@str) history_tokenize(str line)
-
-=item C<history_arg_extract(LINE, [FIRST [,LAST]])>
-
- str history_arg_extract(str line, int first = 0, int last = '$')
-
-=back
-
-=back
-
-=back
-
-=head2 C<Term::ReadLine::Gnu> Variables
-
-Following GNU Readline/History Library variables can be accessed from
-Perl program. See 'GNU Readline Library Manual' and ' GNU History
-Library Manual' for each variable. You can access them with
-C<Attribs> methods. Names of keys in this hash conform to standard
-conventions with the leading C<rl_> stripped.
-
-Examples:
-
- $attribs = $term->Attribs;
- $v = $attribs->{library_version}; # rl_library_version
- $v = $attribs->{history_base}; # history_base
-
-=over 4
-
-=item Readline Variables
-
- str rl_line_buffer
- int rl_point
- int rl_end
- int rl_mark
- int rl_done
- int rl_num_chars_to_read (GRL 4.2)
- int rl_pending_input
- int rl_dispatching (GRL 4.2)
- int rl_erase_empty_line (GRL 4.0)
- str rl_prompt (read only)
- int rl_already_prompted (GRL 4.1)
- str rl_library_version (read only)
- int rl_readline_version (read only)
- int rl_gnu_readline_p (GRL 4.2)
- str rl_terminal_name
- str rl_readline_name
- filehandle rl_instream
- filehandle rl_outstream
- int rl_prefer_env_winsize (GRL 5.1)
- pfunc rl_last_func (GRL 4.2)
- pfunc rl_startup_hook
- pfunc rl_pre_input_hook (GRL 4.0)
- pfunc rl_event_hook
- pfunc rl_getc_function
- pfunc rl_redisplay_function
- pfunc rl_prep_term_function (GRL 4.2)
- pfunc rl_deprep_term_function (GRL 4.2)
- Keymap rl_executing_keymap (read only)
- Keymap rl_binding_keymap (read only)
- str rl_executing_macro (GRL 4.2)
- int rl_readline_state (GRL 4.2)
- int rl_explicit_arg (GRL 4.2)
- int rl_numeric_arg (GRL 4.2)
- int rl_editing_mode (GRL 4.2)
-
-=item Signal Handling Variables
-
- int rl_catch_signals (GRL 4.0)
- int rl_catch_sigwinch (GRL 4.0)
-
-=item Completion Variables
-
- pfunc rl_completion_entry_function
- pfunc rl_attempted_completion_function
- pfunc rl_filename_quoting_function
- pfunc rl_filename_dequoting_function
- pfunc rl_char_is_quoted_p
- int rl_completion_query_items
- str rl_basic_word_break_characters
- str rl_basic_quote_characters
- str rl_completer_word_break_characters
- pfunc rl_completion_word_break_hook (GRL 5.0)
- str rl_completer_quote_characters
- str rl_filename_quote_characters
- str rl_special_prefixes
- int rl_completion_append_character
- int rl_completion_suppress_append (GRL 4.3)
- int rl_completion_quote_charactor (GRL 5.0)
- int rl_completion_suppress_quote (GRL 5.0)
- int rl_completion_found_quote (GRL 5.0)
- int rl_completion_mark_symlink_dirs (GRL 4.3)
- int rl_ignore_completion_duplicates
- int rl_filename_completion_desired
- int rl_filename_quoting_desired
- int rl_attempted_completion_over (GRL 4.2)
- int rl_completion_type (GRL 4.2)
- int rl_inhibit_completion
- pfunc rl_ignore_some_completion_function
- pfunc rl_directory_completion_hook
- pfunc rl_completion_display_matches_hook (GRL 4.0)
-
-=item History Variables
-
- int history_base
- int history_length
- int history_max_entries (called `max_input_history'. read only)
- int history_write_timestamps (GRL 5.0)
- char history_expansion_char
- char history_subst_char
- char history_comment_char
- str history_word_delimiters (GRL 4.2)
- str history_no_expand_chars
- str history_search_delimiter_chars
- int history_quotes_inhibit_expansion
- pfunc history_inhibit_expansion_function
-
-=item Function References
-
- rl_getc
- rl_redisplay
- rl_callback_read_char
- rl_display_match_list
- rl_filename_completion_function
- rl_username_completion_function
- list_completion_function
- shadow_redisplay
- Tk_getc
-
-=back
-
-=head2 Custom Completion
-
-In this section variables and functions for custom completion is
-described with examples.
-
-Most of descriptions in this section is cited from GNU Readline
-Library manual.
-
-=over 4
-
-=item C<rl_completion_entry_function>
-
-This variable holds reference refers to a generator function for
-C<completion_matches()>.
-
-A generator function is called repeatedly from
-C<completion_matches()>, returning a string each time. The arguments
-to the generator function are C<TEXT> and C<STATE>. C<TEXT> is the
-partial word to be completed. C<STATE> is zero the first time the
-function is called, allowing the generator to perform any necessary
-initialization, and a positive non-zero integer for each subsequent
-call. When the generator function returns C<undef> this signals
-C<completion_matches()> that there are no more possibilities left.
-
-If the value is undef, built-in C<filename_completion_function> is
-used.
-
-A sample generator function, C<list_completion_function>, is defined
-in Gnu.pm. You can use it as follows;
-
- use Term::ReadLine;
- ...
- my $term = new Term::ReadLine 'sample';
- my $attribs = $term->Attribs;
- ...
- $attribs->{completion_entry_function} =
- $attribs->{list_completion_function};
- ...
- $attribs->{completion_word} =
- [qw(reference to a list of words which you want to use for completion)];
- $term->readline("custom completion>");
-
-See also C<completion_matches>.
-
-=item C<rl_attempted_completion_function>
-
-A reference to an alternative function to create matches.
-
-The function is called with C<TEXT>, C<LINE_BUFFER>, C<START>, and
-C<END>. C<LINE_BUFFER> is a current input buffer string. C<START>
-and C<END> are indices in C<LINE_BUFFER> saying what the boundaries of
-C<TEXT> are.
-
-If this function exists and returns null list or C<undef>, or if this
-variable is set to C<undef>, then an internal function
-C<rl_complete()> will call the value of
-C<$rl_completion_entry_function> to generate matches, otherwise the
-array of strings returned will be used.
-
-The default value of this variable is C<undef>. You can use it as follows;
-
- use Term::ReadLine;
- ...
- my $term = new Term::ReadLine 'sample';
- my $attribs = $term->Attribs;
- ...
- sub sample_completion {
- my ($text, $line, $start, $end) = @_;
- # If first word then username completion, else filename completion
- if (substr($line, 0, $start) =~ /^\s*$/) {
- return $term->completion_matches($text,
- $attribs->{'username_completion_function'});
- } else {
- return ();
- }
- }
- ...
- $attribs->{attempted_completion_function} = \&sample_completion;
-
-=item C<completion_matches(TEXT, ENTRY_FUNC)>
-
-Returns an array of strings which is a list of completions for
-C<TEXT>. If there are no completions, returns C<undef>. The first
-entry in the returned array is the substitution for C<TEXT>. The
-remaining entries are the possible completions.
-
-C<ENTRY_FUNC> is a generator function which has two arguments, and
-returns a string. The first argument is C<TEXT>. The second is a
-state argument; it is zero on the first call, and non-zero on
-subsequent calls. C<ENTRY_FUNC> returns a C<undef> to the caller when
-there are no more matches.
-
-If the value of C<ENTRY_FUNC> is undef, built-in
-C<filename_completion_function> is used.
-
-C<completion_matches> is a Perl wrapper function of an internal
-function C<completion_matches()>. See also
-C<$rl_completion_entry_function>.
-
-=item C<completion_function>
-
-A variable whose content is a reference to a function which returns a
-list of candidates to complete.
-
-This variable is compatible with C<Term::ReadLine::Perl> and very easy
-to use.
-
- use Term::ReadLine;
- ...
- my $term = new Term::ReadLine 'sample';
- my $attribs = $term->Attribs;
- ...
- $attribs->{completion_function} = sub {
- my ($text, $line, $start) = @_;
- return qw(a list of candidates to complete);
- }
-
-=item C<list_completion_function(TEXT, STATE)>
-
-A sample generator function defined by C<Term::ReadLine::Gnu>.
-Example code at C<rl_completion_entry_function> shows how to use this
-function.
-
-=back
-
-=head2 C<Term::ReadLine::Gnu> Specific Features
-
-=over 4
-
-=item C<Term::ReadLine::Gnu> Specific Functions
-
-=over 4
-
-=item C<CallbackHandlerInstall(PROMPT, LHANDLER)>
-
-This method provides the function C<rl_callback_handler_install()>
-with the following addtional feature compatible with C<readline>
-method; ornament feature, C<Term::ReadLine::Perl> compatible
-completion function, histroy expansion, and addition to history
-buffer.
-
-=item C<call_function(FUNCTION, [COUNT [,KEY]])>
-
- int rl_call_function(FunctionPtr|str function, count = 1, key = -1)
-
-=item C<rl_get_all_function_names>
-
-Returns a list of all function names.
-
-=item C<shadow_redisplay>
-
-A redisplay function for password input. You can use it as follows;
-
- $attribs->{redisplay_function} = $attribs->{shadow_redisplay};
- $line = $term->readline("password> ");
-
-=item C<rl_filename_list>
-
-Returns candidates of filename to complete. This function can be used
-with C<completion_function> and is implemented for the compatibility
-with C<Term::ReadLine::Perl>.
-
-=item C<list_completion_function>
-
-See the description of section L<"Custom Completion"|"Custom Completion">.
-
-=back
-
-=item C<Term::ReadLine::Gnu> Specific Variables
-
-=over 4
-
-=item C<do_expand>
-
-When true, the history expansion is enabled. By default false.
-
-=item C<completion_function>
-
-See the description of section L<"Custom Completion"|"Custom Completion">.
-
-=item C<completion_word>
-
-A reference to a list of candidates to complete for
-C<list_completion_function>.
-
-=back
-
-=item C<Term::ReadLine::Gnu> Specific Commands
-
-=over 4
-
-=item C<history-expand-line>
-
-The equivalent of the Bash C<history-expand-line> editing command.
-
-=item C<operate-and-get-next>
-
-The equivalent of the Korn shell C<operate-and-get-next-history-line>
-editing command and the Bash C<operate-and-get-next>.
-
-This command is bound to C<\C-o> by default for the compatibility with
-the Bash and C<Term::ReadLine::Perl>.
-
-=item C<display-readline-version>
-
-Shows the version of C<Term::ReadLine::Gnu> and the one of the GNU
-Readline Library.
-
-=item C<change-ornaments>
-
-Change ornaments interactively.
-
-=back
-
-=back
-
-=head1 FILES
-
-=over 4
-
-=item F<~/.inputrc>
-
-Readline init file. Using this file it is possible that you would
-like to use a different set of key bindings. When a program which
-uses the Readline library starts up, the init file is read, and the
-key bindings are set.
-
-Conditional key binding is also available. The program name which is
-specified by the first argument of C<new> method is used as the
-application construct.
-
-For example, when your program call C<new> method like this;
-
- ...
- $term = new Term::ReadLine 'PerlSh';
- ...
-
-your F<~/.inputrc> can define key bindings only for it as follows;
-
- ...
- $if PerlSh
- Meta-Rubout: backward-kill-word
- "\C-x\C-r": re-read-init-file
- "\e[11~": "Function Key 1"
- $endif
- ...
-
-=back
-
-=head1 EXPORTS
-
-None.
-
-=head1 SEE ALSO
-
-=over 4
-
-=item GNU Readline Library Manual
-
-=item GNU History Library Manual
-
-=item C<Term::ReadLine>
-
-=item C<Term::ReadLine::Perl> (Term-ReadLine-Perl-xx.tar.gz)
-
-=item F<eg/*> and F<t/*> in the Term::ReadLine::Gnu distribution
-
-=item Articles related to Term::ReadLine::Gnu
-
-=over 4
-
-=item effective perl programming
-
- http://www.usenix.org/publications/login/2000-7/features/effective.html
-
-This article demonstrates how to integrate Term::ReadLine::Gnu into an
-interactive command line program.
-
-=item eijiro (Japanese)
-
- http://bulknews.net/lib/columns/02_eijiro/column.html
-
-A command line interface to Eijiro, Japanese-English dictionary
-service on WWW.
-
-
-=back
-
-=item Works which use Term::ReadLine::Gnu
-
-=over 4
-
-=item Perl Debugger
-
- perl -d
-
-=item The Perl Shell (psh)
-
- http://www.focusresearch.com/gregor/psh/
-
-The Perl Shell is a shell that combines the interactive nature of a
-Unix shell with the power of Perl.
-
-A programmable completion feature compatible with bash is implemented.
-
-=item SPP (Synopsys Plus Perl)
-
- http://www.stanford.edu/~jsolomon/SPP/
-
-SPP (Synopsys Plus Perl) is a Perl module that wraps around Synopsys'
-shell programs. SPP is inspired by the original dc_perl written by
-Steve Golson, but it's an entirely new implementation. Why is it
-called SPP and not dc_perl? Well, SPP was written to wrap around any
-of Synopsys' shells.
-
-=item PFM (Personal File Manager for Unix/Linux)
-
- http://p-f-m.sourceforge.net/
-
-Pfm is a terminal-based file manager written in Perl, based on PFM.COM
-for MS-DOS (originally by Paul Culley and Henk de Heer).
-
-=item The soundgrab
-
- http://rawrec.sourceforge.net/soundgrab/soundgrab.html
-
-soundgrab is designed to help you slice up a big long raw audio file
-(by default 44.1 kHz 2 channel signed sixteen bit little endian) and
-save your favorite sections to other files. It does this by providing
-you with a cassette player like command line interface.
-
-=item PDL (The Perl Data Language)
-
- http://pdl.perl.org/index_en.html
-
-PDL (``Perl Data Language'') gives standard Perl the ability to
-compactly store and speedily manipulate the large N-dimensional data
-arrays which are the bread and butter of scientific computing.
-
-=item PIQT (Perl Interactive DBI Query Tool)
-
- http://piqt.sourceforge.net/
-
-PIQT is an interactive query tool using the Perl DBI database
-interface. It supports ReadLine, provides a built in scripting language
-with a Lisp like syntax, an online help system, and uses wrappers to
-interface to the DBD modules.
-
-=item Ghostscript Shell
-
- http://www.panix.com/~jdf/gshell/
-
-It provides a friendly way to play with the Ghostscript interpreter,
-including command history and auto-completion of Postscript font names
-and reserved words.
-
-=item vshnu (the New Visual Shell)
-
- http://www.cs.indiana.edu/~kinzler/vshnu/
-
-A visual shell and CLI shell supplement.
-
-=back
-
-If you know any other works which can be listed here, please let me
-know.
-
-=back
-
-=head1 AUTHOR
-
-Hiroo Hayashi C<E<lt>hiroo.hayashi@computer.orgE<gt>>
-
-C<http://www.perl.org/CPAN/authors/Hiroo_HAYASHI/>
-
-=head1 TODO
-
-GTK+ support in addition to Tk.
-
-=head1 BUGS
-
-C<rl_add_defun()> can define up to 16 functions.
-
-Ornament feature works only on prompt strings. It requires very hard
-hacking of C<display.c:rl_redisplay()> in GNU Readline library to
-ornament input line.
-
-C<newTTY()> is not tested yet.
-
-=cut
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Term/ReadLine/Gnu/XS.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Term/ReadLine/Gnu/XS.pm
deleted file mode 100644
index 6b2667c780e..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/Term/ReadLine/Gnu/XS.pm
+++ /dev/null
@@ -1,590 +0,0 @@
-#!/usr/local/bin/perl
-#
-# XS.pm : perl function definition for Term::ReadLine::Gnu
-#
-# $Id: XS.pm,v 1.23 2008-02-08 00:43:46+09 hiroo Exp $
-#
-# Copyright (c) 2008 Hiroo Hayashi. All rights reserved.
-#
-# This program is free software; you can redistribute it and/or
-# modify it under the same terms as Perl itself.
-
-package Term::ReadLine::Gnu::XS;
-
-use Carp;
-use strict;
-use AutoLoader 'AUTOLOAD';
-
-use vars qw($VERSION);
-$VERSION='1.17'; # added for CPAN
-
-# make aliases
-use vars qw(%Attribs);
-*Attribs = \%Term::ReadLine::Gnu::Attribs;
-
-use vars qw(*read_history);
-*read_history = \&read_history_range;
-
-# alias for 8 characters limitation imposed by AutoSplit
-use vars qw(*rl_unbind_key *rl_unbind_function *rl_unbind_command
- *history_list *history_arg_extract);
-*rl_unbind_key = \&unbind_key;
-*rl_unbind_function = \&unbind_function;
-*rl_unbind_command = \&unbind_command;
-*history_list = \&hist_list;
-*history_arg_extract = \&hist_arg_extract;
-
-# For backward compatibility. Using these name (*_in_map) is deprecated.
-use vars qw(*rl_unbind_function_in_map *rl_unbind_command_in_map);
-*rl_unbind_function_in_map = \&unbind_function;
-*rl_unbind_command_in_map = \&unbind_command;
-
-rl_add_defun('history-expand-line', \&history_expand_line);
-# bind operate-and-get-next to \C-o by default for the compatibility
-# with bash and Term::ReadLine::Perl
-rl_add_defun('operate-and-get-next', \&operate_and_get_next, ord "\co");
-rl_add_defun('display-readline-version', \&display_readline_version);
-rl_add_defun('change-ornaments', \&change_ornaments);
-
-# for ornaments()
-
-# Prompt-start, prompt-end, command-line-start, command-line-end
-# -- zero-width beautifies to emit around prompt and the command line.
-# string encoded:
-my $rl_term_set = ',,,';
-
-# These variables are used by completion functions. Don't use for
-# other purpose.
-my $_i;
-my @_matches;
-my @_tstrs;
-my $_tstrs_init = 0;
-
-1;
-
-# Uncomment the following line to enable AutoSplit. If you are using
-# AutoLoader.pm distributed with Perl 5.004 or earlier, you must
-# update AutoLoader.pm due to its bug.
-
-#__END__
-
-
-#
-# Readline Library function wrappers
-#
-
-# Convert keymap name to Keymap if the argument is not reference to Keymap
-sub _str2map ($) {
- return ref $_[0] ? $_[0]
- : (rl_get_keymap_by_name($_[0]) || carp "unknown keymap name \`$_[0]\'\n");
-}
-
-# Convert function name to Function if the argument is not reference
-# to Function
-sub _str2fn ($) {
- return ref $_[0] ? $_[0]
- : (rl_named_function($_[0]) || carp "unknown function name \`$_[0]\'\n");
-}
-
-sub rl_copy_keymap ($) { return _rl_copy_keymap(_str2map($_[0])); }
-sub rl_discard_keymap ($) { return _rl_discard_keymap(_str2map($_[0])); }
-sub rl_set_keymap ($) { return _rl_set_keymap(_str2map($_[0])); }
-
-# rl_bind_key
-sub rl_bind_key ($$;$) {
- if (defined $_[2]) {
- return _rl_bind_key($_[0], _str2fn($_[1]), _str2map($_[2]));
- } else {
- return _rl_bind_key($_[0], _str2fn($_[1]));
- }
-}
-
-# rl_bind_key_if_unbound
-sub rl_bind_key_if_unbound ($$;$) {
- my ($version) = $Attribs{library_version}
- =~ /(\d+\.\d+)/;
- if ($version < 5.0) {
- carp "rl_bind_key_if_unbound() is not supported. Ignored\n";
- return;
- }
- if (defined $_[2]) {
- return _rl_bind_key_if_unbound($_[0], _str2fn($_[1]), _str2map($_[2]));
- } else {
- return _rl_bind_key_if_unbound($_[0], _str2fn($_[1]));
- }
-}
-
-# rl_unbind_key
-sub unbind_key ($;$) {
- if (defined $_[1]) {
- return _rl_unbind_key($_[0], _str2map($_[1]));
- } else {
- return _rl_unbind_key($_[0]);
- }
-}
-
-# rl_unbind_function
-sub unbind_function ($;$) {
- # libreadline.* in Debian GNU/Linux 2.0 tells wrong value as '2.1-bash'
- my ($version) = $Attribs{library_version}
- =~ /(\d+\.\d+)/;
- if ($version < 2.2) {
- carp "rl_unbind_function() is not supported. Ignored\n";
- return;
- }
- if (defined $_[1]) {
- return _rl_unbind_function($_[0], _str2map($_[1]));
- } else {
- return _rl_unbind_function($_[0]);
- }
-}
-
-# rl_unbind_command
-sub unbind_command ($;$) {
- my ($version) = $Attribs{library_version}
- =~ /(\d+\.\d+)/;
- if ($version < 2.2) {
- carp "rl_unbind_command() is not supported. Ignored\n";
- return;
- }
- if (defined $_[1]) {
- return _rl_unbind_command($_[0], _str2map($_[1]));
- } else {
- return _rl_unbind_command($_[0]);
- }
-}
-
-# rl_bind_keyseq
-sub rl_bind_keyseq ($$;$) {
- my ($version) = $Attribs{library_version}
- =~ /(\d+\.\d+)/;
- if ($version < 5.0) {
- carp "rl_bind_keyseq() is not supported. Ignored\n";
- return;
- }
- if (defined $_[2]) {
- return _rl_bind_keyseq($_[0], _str2fn($_[1]), _str2map($_[2]));
- } else {
- return _rl_bind_keyseq($_[0], _str2fn($_[1]));
- }
-}
-
-sub rl_set_key ($$;$) {
- my ($version) = $Attribs{library_version}
- =~ /(\d+\.\d+)/;
- if ($version < 4.2) {
- carp "rl_set_key() is not supported. Ignored\n";
- return;
- }
- if (defined $_[2]) {
- return _rl_set_key($_[0], _str2fn($_[1]), _str2map($_[2]));
- } else {
- return _rl_set_key($_[0], _str2fn($_[1]));
- }
-}
-
-# rl_bind_keyseq_if_unbound
-sub rl_bind_keyseq_if_unbound ($$;$) {
- my ($version) = $Attribs{library_version}
- =~ /(\d+\.\d+)/;
- if ($version < 5.0) {
- carp "rl_bind_keyseq_if_unbound() is not supported. Ignored\n";
- return;
- }
- if (defined $_[2]) {
- return _rl_bind_keyseq_if_unbound($_[0], _str2fn($_[1]), _str2map($_[2]));
- } else {
- return _rl_bind_keyseq_if_unbound($_[0], _str2fn($_[1]));
- }
-}
-
-sub rl_macro_bind ($$;$) {
- my ($version) = $Attribs{library_version}
- =~ /(\d+\.\d+)/;
- if (defined $_[2]) {
- return _rl_macro_bind($_[0], $_[1], _str2map($_[2]));
- } else {
- return _rl_macro_bind($_[0], $_[1]);
- }
-}
-
-sub rl_generic_bind ($$$;$) {
- if ($_[0] == Term::ReadLine::Gnu::ISFUNC) {
- if (defined $_[3]) {
- _rl_generic_bind_function($_[1], _str2fn($_[2]), _str2map($_[3]));
- } else {
- _rl_generic_bind_function($_[1], _str2fn($_[2]));
- }
- } elsif ($_[0] == Term::ReadLine::Gnu::ISKMAP) {
- if (defined $_[3]) {
- _rl_generic_bind_keymap($_[1], _str2map($_[2]), _str2map($_[3]));
- } else {
- _rl_generic_bind_keymap($_[1], _str2map($_[2]));
- }
- } elsif ($_[0] == Term::ReadLine::Gnu::ISMACR) {
- if (defined $_[3]) {
- _rl_generic_bind_macro($_[1], $_[2], _str2map($_[3]));
- } else {
- _rl_generic_bind_macro($_[1], $_[2]);
- }
- } else {
- carp("Term::ReadLine::Gnu::rl_generic_bind: invalid \`type\'\n");
- }
-}
-
-sub rl_call_function ($;$$) {
- if (defined $_[2]) {
- return _rl_call_function(_str2fn($_[0]), $_[1], $_[2]);
- } elsif (defined $_[1]) {
- return _rl_call_function(_str2fn($_[0]), $_[1]);
- } else {
- return _rl_call_function(_str2fn($_[0]));
- }
-}
-
-sub rl_invoking_keyseqs ($;$) {
- if (defined $_[1]) {
- return _rl_invoking_keyseqs(_str2fn($_[0]), _str2map($_[1]));
- } else {
- return _rl_invoking_keyseqs(_str2fn($_[0]));
- }
-}
-
-sub rl_add_funmap_entry ($$) {
- my ($version) = $Attribs{library_version}
- =~ /(\d+\.\d+)/;
- if ($version < 4.2) {
- carp "rl_add_funmap_entry() is not supported. Ignored\n";
- return;
- }
- return _rl_add_funmap_entry($_[0], _str2fn($_[1]));
-}
-
-sub rl_tty_set_default_bindings (;$) {
- my ($version) = $Attribs{library_version}
- =~ /(\d+\.\d+)/;
- if ($version < 4.2) {
- carp "rl_tty_set_default_bindings() is not supported. Ignored\n";
- return;
- }
- if (defined $_[0]) {
- return _rl_tty_set_defaut_bindings(_str2map($_[1]));
- } else {
- return _rl_tty_set_defaut_bindings();
- }
-}
-
-sub rl_tty_unset_default_bindings (;$) {
- my ($version) = $Attribs{library_version}
- =~ /(\d+\.\d+)/;
- if ($version < 5.0) {
- carp "rl_tty_unset_default_bindings() is not supported. Ignored\n";
- return;
- }
- if (defined $_[0]) {
- return _rl_tty_unset_defaut_bindings(_str2map($_[1]));
- } else {
- return _rl_tty_unset_defaut_bindings();
- }
-}
-
-sub rl_message {
- my $fmt = shift;
- my $line = sprintf($fmt, @_);
- _rl_message($line);
-}
-
-sub rl_completion_mode {
- # libreadline.* in Debian GNU/Linux 2.0 tells wrong value as '2.1-bash'
- my ($version) = $Attribs{library_version}
- =~ /(\d+\.\d+)/;
- if ($version < 4.3) {
- carp "rl_completion_mode() is not supported. Ignored\n";
- return;
- }
- return _rl_completion_mode(_str2fn($_[0]));
-}
-
-#
-# for compatibility with Term::ReadLine::Perl
-#
-sub rl_filename_list {
- my ($text) = @_;
-
- # lcd : lowest common denominator
- my ($lcd, @matches) = rl_completion_matches($text,
- \&rl_filename_completion_function);
- return @matches ? @matches : $lcd;
-}
-
-#
-# History Library function wrappers
-#
-# history_list
-sub hist_list () {
- my ($i, $history_base, $history_length, @d);
- $history_base = $Attribs{history_base};
- $history_length = $Attribs{history_length};
- for ($i = $history_base; $i < $history_base + $history_length; $i++) {
- push(@d, history_get($i));
- }
- @d;
-}
-
-# history_arg_extract
-sub hist_arg_extract ( ;$$$ ) {
- my ($line, $first, $last) = @_;
- $line = $_ unless defined $line;
- $first = 0 unless defined $first;
- $last = ord '$' unless defined $last; # '
- $first = ord '$' if defined $first and $first eq '$'; # '
- $last = ord '$' if defined $last and $last eq '$'; # '
- &_history_arg_extract($line, $first, $last);
-}
-
-sub get_history_event ( $$;$ ) {
- _get_history_event($_[0], $_[1], defined $_[2] ? ord $_[2] : 0);
-}
-
-#
-# Ornaments
-#
-
-# This routine originates in Term::ReadLine.pm.
-
-# Debian GNU/Linux discourages users from using /etc/termcap. A
-# subroutine ornaments() defined in Term::ReadLine.pm uses
-# Term::Caps.pm which requires /etc/termcap.
-
-# This module calls termcap (or its compatible) library, which the GNU
-# Readline Library already uses, instead of Term::Caps.pm.
-
-# Some terminals do not support 'ue' (underline end).
-use vars qw(%term_no_ue);
-%term_no_ue = ( kterm => 1 );
-
-sub ornaments {
- return $rl_term_set unless @_;
- $rl_term_set = shift;
- $rl_term_set ||= ',,,';
- $rl_term_set = $term_no_ue{$ENV{TERM}} ? 'us,me,,' : 'us,ue,,'
- if $rl_term_set eq '1';
- my @ts = split /,/, $rl_term_set, 4;
- my @rl_term_set
- = map {
- # non-printing characters must be informed to readline
- my $t;
- ($_ and $t = tgetstr($_))
- ? (Term::ReadLine::Gnu::RL_PROMPT_START_IGNORE
- . $t
- . Term::ReadLine::Gnu::RL_PROMPT_END_IGNORE)
- : '';
- } @ts;
- $Attribs{term_set} = \@rl_term_set;
- return $rl_term_set;
-}
-
-#
-# a sample custom function
-#
-
-# The equivalent of the Bash shell M-^ history-expand-line editing
-# command.
-
-# This routine was borrowed from bash.
-sub history_expand_line {
- my ($count, $key) = @_;
- my ($expanded, $new_line) = history_expand($Attribs{line_buffer});
- if ($expanded > 0) {
- rl_modifying(0, $Attribs{end}); # save undo information
- $Attribs{line_buffer} = $new_line;
- } elsif ($expanded < 0) {
- my $OUT = $Attribs{outstream};
- print $OUT "\n$new_line\n";
- rl_on_new_line();
- } # $expanded == 0 : no change
-}
-
-# The equivalent of the Korn shell C-o operate-and-get-next-history-line
-# editing command.
-
-# This routine was borrowed from bash.
-sub operate_and_get_next {
- my ($count, $key) = @_;
-
- my $saved_history_line_to_use = -1;
- my $old_rl_startup_hook;
-
- # Accept the current line.
- rl_call_function('accept-line', 1, $key);
-
- # Find the current line, and find the next line to use. */
- my $where = where_history();
- if ((history_is_stifled()
- && ($Attribs{history_length} >= $Attribs{max_input_history}))
- || ($where >= $Attribs{history_length} - 1)) {
- $saved_history_line_to_use = $where;
- } else {
- $saved_history_line_to_use = $where + 1;
- }
- $old_rl_startup_hook = $Attribs{startup_hook};
- $Attribs{startup_hook} = sub {
- if ($saved_history_line_to_use >= 0) {
- rl_call_function('previous-history',
- $Attribs{history_length}
- - $saved_history_line_to_use,
- 0);
- $Attribs{startup_hook} = $old_rl_startup_hook;
- $saved_history_line_to_use = -1;
- }
- };
-}
-
-sub display_readline_version { # show version
- my($count, $key) = @_; # ignored in this function
- my $OUT = $Attribs{outstream};
- print $OUT
- ("\nTerm::ReadLine::Gnu version: $Term::ReadLine::Gnu::VERSION");
- print $OUT
- ("\nGNU Readline Library version: $Attribs{library_version}\n");
- rl_on_new_line();
-}
-
-# sample function of rl_message()
-sub change_ornaments {
- my($count, $key) = @_; # ignored in this function
- rl_save_prompt;
- rl_message("[S]tandout, [U]nderlining, [B]old, [R]everse, [V]isible bell: ");
- my $c = chr rl_read_key;
- if ($c =~ /s/i) {
- ornaments('so,me,,');
- } elsif ($c =~ /u/i) {
- ornaments('us,me,,');
- } elsif ($c =~ /b/i) {
- ornaments('md,me,,');
- } elsif ($c =~ /r/i) {
- ornaments('mr,me,,');
- } elsif ($c =~ /v/i) {
- ornaments('vb,,,');
- } else {
- rl_ding;
- }
- rl_restore_prompt;
- rl_clear_message;
-}
-
-#
-# for tkRunning
-#
-sub Tk_getc {
- &Term::ReadLine::Tk::Tk_loop
- if $Term::ReadLine::toloop && defined &Tk::DoOneEvent;
- my $FILE = $Attribs{instream};
- return rl_getc($FILE);
-}
-
-# redisplay function for secret input like password
-# usage:
-# $a->{redisplay_function} = $a->{shadow_redisplay};
-# $line = $t->readline("password> ");
-sub shadow_redisplay {
- @_tstrs = _tgetstrs() unless $_tstrs_init;
- # remove prompt start/end mark from prompt string
- my $prompt = $Attribs{prompt}; my $s;
- $s = Term::ReadLine::Gnu::RL_PROMPT_START_IGNORE; $prompt =~ s/$s//g;
- $s = Term::ReadLine::Gnu::RL_PROMPT_END_IGNORE; $prompt =~ s/$s//g;
- my $OUT = $Attribs{outstream};
- my $oldfh = select($OUT); $| = 1; select($oldfh);
- print $OUT ($_tstrs[0], # carriage return
- $_tstrs[1], # clear to EOL
- $prompt, '*' x length($Attribs{line_buffer}));
- print $OUT ($_tstrs[2] # cursor left
- x (length($Attribs{line_buffer}) - $Attribs{point}));
- $oldfh = select($OUT); $| = 0; select($oldfh);
-}
-
-sub _tgetstrs {
- my @s = (tgetstr('cr'), # carriage return
- tgetstr('ce'), # clear to EOL
- tgetstr('le')); # cursor left
- warn <<"EOM" unless (defined($s[0]) && defined($s[1]) && defined($s[2]));
-Your terminal 'TERM=$ENV{TERM}' does not support enough function.
-Check if your environment variable 'TERM' is set correctly.
-EOM
- # suppress warning "Use of uninitialized value in print at ..."
- $s[0] = $s[0] || ''; $s[1] = $s[1] || ''; $s[2] = $s[2] || '';
- $_tstrs_init = 1;
- return @s;
-}
-
-# callback handler wrapper function for CallbackHandlerInstall method
-sub _ch_wrapper {
- my $line = shift;
-
- if (defined $line) {
- if ($Attribs{do_expand}) {
- my $result;
- ($result, $line) = history_expand($line);
- my $outstream = $Attribs{outstream};
- print $outstream "$line\n" if ($result);
-
- # return without adding line into history
- if ($result < 0 || $result == 2) {
- return ''; # don't return `undef' which means EOF.
- }
- }
-
- # add to history buffer
- add_history($line)
- if ($Attribs{MinLength} > 0
- && length($line) >= $Attribs{MinLength});
- }
- &{$Attribs{_callback_handler}}($line);
-}
-
-#
-# List Completion Function
-#
-sub list_completion_function ( $$ ) {
- my($text, $state) = @_;
-
- $_i = $state ? $_i + 1 : 0; # clear counter at the first call
- my $cw = $Attribs{completion_word};
- for (; $_i <= $#{$cw}; $_i++) {
- return $cw->[$_i] if ($cw->[$_i] =~ /^\Q$text/);
- }
- return undef;
-}
-
-#
-# wrapper completion function of 'completion_function'
-# for compatibility with Term::ReadLine::Perl
-#
-sub _trp_completion_function ( $$ ) {
- my($text, $state) = @_;
-
- my $cf;
- return undef unless defined ($cf = $Attribs{completion_function});
-
- if ($state) {
- $_i++;
- } else {
- # the first call
- $_i = 0; # clear index
- @_matches = &$cf($text,
- $Attribs{line_buffer},
- $Attribs{point} - length($text));
- # return here since $#_matches is 0 instead of -1 when
- # @_matches = undef
- return undef unless defined $_matches[0];
- }
-
- for (; $_i <= $#_matches; $_i++) {
- return $_matches[$_i] if ($_matches[$_i] =~ /^\Q$text/);
- }
- return undef;
-}
-
-1;
-
-__END__
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML.pm
deleted file mode 100644
index 6b7d6d845c5..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML.pm
+++ /dev/null
@@ -1,1778 +0,0 @@
-# $Id: LibXML.pm 709 2008-01-29 21:01:32Z pajas $
-
-package XML::LibXML;
-
-use strict;
-use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS
- $skipDTD $skipXMLDeclaration $setTagCompression
- $MatchCB $ReadCB $OpenCB $CloseCB
- );
-use Carp;
-
-use XML::LibXML::Common qw(:encoding :libxml);
-
-use constant XML_XMLNS_NS => 'http://www.w3.org/2000/xmlns/';
-use constant XML_XML_NS => 'http://www.w3.org/XML/1998/namespace';
-
-use XML::LibXML::NodeList;
-use XML::LibXML::XPathContext;
-use IO::Handle; # for FH reads called as methods
-
-BEGIN {
-
-$VERSION = "1.66"; # VERSION TEMPLATE: DO NOT CHANGE
-require Exporter;
-require DynaLoader;
-@ISA = qw(DynaLoader Exporter);
-
-#-------------------------------------------------------------------------#
-# export information #
-#-------------------------------------------------------------------------#
-%EXPORT_TAGS = (
- all => [qw(
- XML_ELEMENT_NODE
- XML_ATTRIBUTE_NODE
- XML_TEXT_NODE
- XML_CDATA_SECTION_NODE
- XML_ENTITY_REF_NODE
- XML_ENTITY_NODE
- XML_PI_NODE
- XML_COMMENT_NODE
- XML_DOCUMENT_NODE
- XML_DOCUMENT_TYPE_NODE
- XML_DOCUMENT_FRAG_NODE
- XML_NOTATION_NODE
- XML_HTML_DOCUMENT_NODE
- XML_DTD_NODE
- XML_ELEMENT_DECL
- XML_ATTRIBUTE_DECL
- XML_ENTITY_DECL
- XML_NAMESPACE_DECL
- XML_XINCLUDE_END
- XML_XINCLUDE_START
- encodeToUTF8
- decodeFromUTF8
- XML_XMLNS_NS
- XML_XML_NS
- )],
- libxml => [qw(
- XML_ELEMENT_NODE
- XML_ATTRIBUTE_NODE
- XML_TEXT_NODE
- XML_CDATA_SECTION_NODE
- XML_ENTITY_REF_NODE
- XML_ENTITY_NODE
- XML_PI_NODE
- XML_COMMENT_NODE
- XML_DOCUMENT_NODE
- XML_DOCUMENT_TYPE_NODE
- XML_DOCUMENT_FRAG_NODE
- XML_NOTATION_NODE
- XML_HTML_DOCUMENT_NODE
- XML_DTD_NODE
- XML_ELEMENT_DECL
- XML_ATTRIBUTE_DECL
- XML_ENTITY_DECL
- XML_NAMESPACE_DECL
- XML_XINCLUDE_END
- XML_XINCLUDE_START
- )],
- encoding => [qw(
- encodeToUTF8
- decodeFromUTF8
- )],
- ns => [qw(
- XML_XMLNS_NS
- XML_XML_NS
- )],
- );
-
-@EXPORT_OK = (
- @{$EXPORT_TAGS{all}},
- );
-
-@EXPORT = (
- @{$EXPORT_TAGS{all}},
- );
-
-#-------------------------------------------------------------------------#
-# initialization of the global variables #
-#-------------------------------------------------------------------------#
-$skipDTD = 0;
-$skipXMLDeclaration = 0;
-$setTagCompression = 0;
-
-$MatchCB = undef;
-$ReadCB = undef;
-$OpenCB = undef;
-$CloseCB = undef;
-
-#-------------------------------------------------------------------------#
-# bootstrapping #
-#-------------------------------------------------------------------------#
-bootstrap XML::LibXML $VERSION;
-undef &AUTOLOAD;
-
-} # BEGIN
-
-#-------------------------------------------------------------------------#
-# test exact version (up to patch-level) #
-#-------------------------------------------------------------------------#
-{
- my ($runtime_version) = LIBXML_RUNTIME_VERSION() =~ /^(\d+)/;
- if ( $runtime_version < LIBXML_VERSION ) {
- warn "Warning: XML::LibXML compiled against libxml2 ".LIBXML_VERSION.
- ", but runtime libxml2 is older $runtime_version\n";
- }
-}
-
-#-------------------------------------------------------------------------#
-# parser constructor #
-#-------------------------------------------------------------------------#
-sub new {
- my $class = shift;
- my %options = @_;
- if ( not exists $options{XML_LIBXML_KEEP_BLANKS} ) {
- $options{XML_LIBXML_KEEP_BLANKS} = 1;
- }
-
- if ( defined $options{catalog} ) {
- $class->load_catalog( $options{catalog} );
- delete $options{catalog};
- }
-
- my $self = bless \%options, $class;
- if ( defined $options{Handler} ) {
- $self->set_handler( $options{Handler} );
- }
-
- $self->{XML_LIBXML_EXT_DTD} = 1;
- $self->{_State_} = 0;
- return $self;
-}
-
-#-------------------------------------------------------------------------#
-# Threads support methods #
-#-------------------------------------------------------------------------#
-
-# threads doc says CLONE's API may change in future, which would break
-# an XS method prototype
-sub CLONE { XML::LibXML::_CLONE( $_[0] ) }
-
-#-------------------------------------------------------------------------#
-# DOM Level 2 document constructor #
-#-------------------------------------------------------------------------#
-
-sub createDocument {
- my $self = shift;
- if (!@_ or $_[0] =~ m/^\d\.\d$/) {
- # for backward compatibility
- return XML::LibXML::Document->new(@_);
- }
- else {
- # DOM API: createDocument(namespaceURI, qualifiedName, doctype?)
- my $doc = XML::LibXML::Document-> new;
- my $el = $doc->createElementNS(shift, shift);
- $doc->setDocumentElement($el);
- $doc->setExternalSubset(shift) if @_;
- return $doc;
- }
-}
-
-#-------------------------------------------------------------------------#
-# callback functions #
-#-------------------------------------------------------------------------#
-
-sub input_callbacks {
- my $self = shift;
- my $icbclass = shift;
-
- if ( defined $icbclass ) {
- $self->{XML_LIBXML_CALLBACK_STACK} = $icbclass;
- }
- return $self->{XML_LIBXML_CALLBACK_STACK};
-}
-
-sub match_callback {
- my $self = shift;
- if ( ref $self ) {
- if ( scalar @_ ) {
- $self->{XML_LIBXML_MATCH_CB} = shift;
- $self->{XML_LIBXML_CALLBACK_STACK} = undef;
- }
- return $self->{XML_LIBXML_MATCH_CB};
- }
- else {
- $MatchCB = shift if scalar @_;
- return $MatchCB;
- }
-}
-
-sub read_callback {
- my $self = shift;
- if ( ref $self ) {
- if ( scalar @_ ) {
- $self->{XML_LIBXML_READ_CB} = shift;
- $self->{XML_LIBXML_CALLBACK_STACK} = undef;
- }
- return $self->{XML_LIBXML_READ_CB};
- }
- else {
- $ReadCB = shift if scalar @_;
- return $ReadCB;
- }
-}
-
-sub close_callback {
- my $self = shift;
- if ( ref $self ) {
- if ( scalar @_ ) {
- $self->{XML_LIBXML_CLOSE_CB} = shift;
- $self->{XML_LIBXML_CALLBACK_STACK} = undef;
- }
- return $self->{XML_LIBXML_CLOSE_CB};
- }
- else {
- $CloseCB = shift if scalar @_;
- return $CloseCB;
- }
-}
-
-sub open_callback {
- my $self = shift;
- if ( ref $self ) {
- if ( scalar @_ ) {
- $self->{XML_LIBXML_OPEN_CB} = shift;
- $self->{XML_LIBXML_CALLBACK_STACK} = undef;
- }
- return $self->{XML_LIBXML_OPEN_CB};
- }
- else {
- $OpenCB = shift if scalar @_;
- return $OpenCB;
- }
-}
-
-sub callbacks {
- my $self = shift;
- if ( ref $self ) {
- if (@_) {
- my ($match, $open, $read, $close) = @_;
- @{$self}{qw(XML_LIBXML_MATCH_CB XML_LIBXML_OPEN_CB XML_LIBXML_READ_CB XML_LIBXML_CLOSE_CB)} = ($match, $open, $read, $close);
- $self->{XML_LIBXML_CALLBACK_STACK} = undef;
- }
- else {
- return @{$self}{qw(XML_LIBXML_MATCH_CB XML_LIBXML_OPEN_CB XML_LIBXML_READ_CB XML_LIBXML_CLOSE_CB)};
- }
- }
- else {
- if (@_) {
- ( $MatchCB, $OpenCB, $ReadCB, $CloseCB ) = @_;
- }
- else {
- return ( $MatchCB, $OpenCB, $ReadCB, $CloseCB );
- }
- }
-}
-
-#-------------------------------------------------------------------------#
-# member variable manipulation #
-#-------------------------------------------------------------------------#
-sub validation {
- my $self = shift;
- $self->{XML_LIBXML_VALIDATION} = shift if scalar @_;
- return $self->{XML_LIBXML_VALIDATION};
-}
-
-sub recover {
- my $self = shift;
- $self->{XML_LIBXML_RECOVER} = shift if scalar @_;
- return $self->{XML_LIBXML_RECOVER};
-}
-
-sub recover_silently {
- my $self = shift;
- my $arg = shift;
- (($arg == 1) ? $self->recover(2) : $self->recover($arg)) if defined($arg);
- return ($self->recover() == 2) ? 1 : 0;
-}
-
-sub expand_entities {
- my $self = shift;
- $self->{XML_LIBXML_EXPAND_ENTITIES} = shift if scalar @_;
- return $self->{XML_LIBXML_EXPAND_ENTITIES};
-}
-
-sub keep_blanks {
- my $self = shift;
- $self->{XML_LIBXML_KEEP_BLANKS} = shift if scalar @_;
- return $self->{XML_LIBXML_KEEP_BLANKS};
-}
-
-sub pedantic_parser {
- my $self = shift;
- $self->{XML_LIBXML_PEDANTIC} = shift if scalar @_;
- return $self->{XML_LIBXML_PEDANTIC};
-}
-
-sub line_numbers {
- my $self = shift;
- $self->{XML_LIBXML_LINENUMBERS} = shift if scalar @_;
- return $self->{XML_LIBXML_LINENUMBERS};
-}
-
-sub no_network {
- my $self = shift;
- $self->{XML_LIBXML_NONET} = shift if scalar @_;
- return $self->{XML_LIBXML_NONET};
-}
-
-sub load_ext_dtd {
- my $self = shift;
- $self->{XML_LIBXML_EXT_DTD} = shift if scalar @_;
- return $self->{XML_LIBXML_EXT_DTD};
-}
-
-sub complete_attributes {
- my $self = shift;
- $self->{XML_LIBXML_COMPLETE_ATTR} = shift if scalar @_;
- return $self->{XML_LIBXML_COMPLETE_ATTR};
-}
-
-sub expand_xinclude {
- my $self = shift;
- $self->{XML_LIBXML_EXPAND_XINCLUDE} = shift if scalar @_;
- return $self->{XML_LIBXML_EXPAND_XINCLUDE};
-}
-
-sub base_uri {
- my $self = shift;
- $self->{XML_LIBXML_BASE_URI} = shift if scalar @_;
- return $self->{XML_LIBXML_BASE_URI};
-}
-
-sub gdome_dom {
- my $self = shift;
- $self->{XML_LIBXML_GDOME} = shift if scalar @_;
- return $self->{XML_LIBXML_GDOME};
-}
-
-sub clean_namespaces {
- my $self = shift;
- $self->{XML_LIBXML_NSCLEAN} = shift if scalar @_;
- return $self->{XML_LIBXML_NSCLEAN};
-}
-
-#-------------------------------------------------------------------------#
-# set the optional SAX(2) handler #
-#-------------------------------------------------------------------------#
-sub set_handler {
- my $self = shift;
- if ( defined $_[0] ) {
- $self->{HANDLER} = $_[0];
-
- $self->{SAX_ELSTACK} = [];
- $self->{SAX} = {State => 0};
- }
- else {
- # undef SAX handling
- $self->{SAX_ELSTACK} = [];
- delete $self->{HANDLER};
- delete $self->{SAX};
- }
-}
-
-#-------------------------------------------------------------------------#
-# helper functions #
-#-------------------------------------------------------------------------#
-sub _auto_expand {
- my ( $self, $result, $uri ) = @_;
-
- $result->setBaseURI( $uri ) if defined $uri;
-
- if ( defined $self->{XML_LIBXML_EXPAND_XINCLUDE}
- and $self->{XML_LIBXML_EXPAND_XINCLUDE} == 1 ) {
- $self->{_State_} = 1;
- eval { $self->processXIncludes($result); };
- my $err = $@;
- $self->{_State_} = 0;
- if ($err) {
- $self->_cleanup_callbacks();
- $result = undef;
- croak $err;
- }
- }
- return $result;
-}
-
-sub _init_callbacks {
- my $self = shift;
- my $icb = $self->{XML_LIBXML_CALLBACK_STACK};
-
- unless ( defined $icb ) {
- $self->{XML_LIBXML_CALLBACK_STACK} = XML::LibXML::InputCallback->new();
- $icb = $self->{XML_LIBXML_CALLBACK_STACK};
- }
-
- my $mcb = $self->match_callback();
- my $ocb = $self->open_callback();
- my $rcb = $self->read_callback();
- my $ccb = $self->close_callback();
-
- if ( defined $mcb and defined $ocb and defined $rcb and defined $ccb ) {
- $icb->register_callbacks( [$mcb, $ocb, $rcb, $ccb] );
- }
-
- $icb->init_callbacks();
-}
-
-sub _cleanup_callbacks {
- my $self = shift;
- $self->{XML_LIBXML_CALLBACK_STACK}->cleanup_callbacks();
- my $mcb = $self->match_callback();
- $self->{XML_LIBXML_CALLBACK_STACK}->unregister_callbacks( [$mcb] );
-}
-
-sub __read {
- read($_[0], $_[1], $_[2]);
-}
-
-sub __write {
- if ( ref( $_[0] ) ) {
- $_[0]->write( $_[1], $_[2] );
- }
- else {
- $_[0]->write( $_[1] );
- }
-}
-
-# currently this is only used in the XInlcude processor
-# but in the future, all parsing functions should turn to
-# the new libxml2 parsing API internally and this will
-# become handy
-sub _parser_options {
- my ($self,$opts)=@_;
- $opts = {} unless ref $opts;
- my $flags = 0;
- $flags |= 1 if exists $opts->{recover} ? $opts->{recover} : $self->recover;
- $flags |= 2 if exists $opts->{expand_entities} ? $opts->{expand_entities} : $self->expand_entities;
- $flags |= 4 if exists $opts->{load_ext_dtd} ? $opts->{load_ext_dtd} : $self->load_ext_dtd;
- $flags |= 8 if exists $opts->{complete_attributes} ? $opts->{complete_attributes} : $self->complete_attributes;
- $flags |= 16 if exists $opts->{validation} ? $opts->{validation} : $self->validation;
- $flags |= 32 if $opts->{suppress_errors};
- $flags |= 64 if $opts->{suppress_warnings};
- $flags |= 128 if exists $opts->{pedantic_parser} ? $opts->{pedantic_parser} : $self->pedantic_parser;
- $flags |= 256 if exists $opts->{no_blanks} ? $opts->{no_blanks} : !$self->keep_blanks();
- $flags |= 1024 if exists $opts->{expand_xinclude} ? $opts->{expand_xinclude} : $self->expand_xinclude;
- $flags |= 2048 if exists $opts->{no_network} ? $opts->{no_network} : $self->no_network;
- $flags |= 8192 if exists $opts->{clean_namespaces} ? $opts->{clean_namespaces} : $self->clean_namespaces;
- $flags |= 16384 if $opts->{no_cdata};
- $flags |= 32768 if $opts->{no_xinclude_nodes};
- return ($flags);
-}
-
-
-#-------------------------------------------------------------------------#
-# parsing functions #
-#-------------------------------------------------------------------------#
-# all parsing functions handle normal as SAX parsing at the same time.
-# note that SAX parsing is handled incomplete! use XML::LibXML::SAX for
-# complete parsing sequences
-#-------------------------------------------------------------------------#
-sub parse_string {
- my $self = shift;
- croak("parse_string is not a class method! Create a parser object with XML::LibXML->new first!") unless ref $self;
- croak("parse already in progress") if $self->{_State_};
-
- unless ( defined $_[0] and length $_[0] ) {
- croak("Empty String");
- }
-
- $self->{_State_} = 1;
- my $result;
-
- $self->_init_callbacks();
-
- if ( defined $self->{SAX} ) {
- my $string = shift;
- $self->{SAX_ELSTACK} = [];
-
- eval { $result = $self->_parse_sax_string($string); };
-
- my $err = $@;
- $self->{_State_} = 0;
- if ($err) {
- chomp $err;
- $self->_cleanup_callbacks();
- croak $err;
- }
- }
- else {
- eval { $result = $self->_parse_string( @_ ); };
-
- my $err = $@;
- $self->{_State_} = 0;
- if ($err) {
- chomp $err;
- $self->_cleanup_callbacks();
- croak $err;
- }
-
- $result = $self->_auto_expand( $result, $self->{XML_LIBXML_BASE_URI} );
- }
- $self->_cleanup_callbacks();
-
- return $result;
-}
-
-sub parse_fh {
- my $self = shift;
- croak("parse_fh is not a class method! Create a parser object with XML::LibXML->new first!") unless ref $self;
- croak("parse already in progress") if $self->{_State_};
- $self->{_State_} = 1;
- my $result;
-
- $self->_init_callbacks();
-
- if ( defined $self->{SAX} ) {
- $self->{SAX_ELSTACK} = [];
- eval { $self->_parse_sax_fh( @_ ); };
- my $err = $@;
- $self->{_State_} = 0;
- if ($err) {
- chomp $err;
- $self->_cleanup_callbacks();
- croak $err;
- }
- }
- else {
- eval { $result = $self->_parse_fh( @_ ); };
- my $err = $@;
- $self->{_State_} = 0;
- if ($err) {
- chomp $err;
- $self->_cleanup_callbacks();
- croak $err;
- }
-
- $result = $self->_auto_expand( $result, $self->{XML_LIBXML_BASE_URI} );
- }
-
- $self->_cleanup_callbacks();
-
- return $result;
-}
-
-sub parse_file {
- my $self = shift;
- croak("parse_file is not a class method! Create a parser object with XML::LibXML->new first!") unless ref $self;
- croak("parse already in progress") if $self->{_State_};
- $self->{_State_} = 1;
- my $result;
-
- $self->_init_callbacks();
-
- if ( defined $self->{SAX} ) {
- $self->{SAX_ELSTACK} = [];
- eval { $self->_parse_sax_file( @_ ); };
- my $err = $@;
- $self->{_State_} = 0;
- if ($err) {
- chomp $err;
- $self->_cleanup_callbacks();
- croak $err;
- }
- }
- else {
- eval { $result = $self->_parse_file(@_); };
- my $err = $@;
- $self->{_State_} = 0;
- if ($err) {
- chomp $err;
- $self->_cleanup_callbacks();
- croak $err;
- }
-
- $result = $self->_auto_expand( $result );
- }
- $self->_cleanup_callbacks();
-
- return $result;
-}
-
-sub parse_xml_chunk {
- my $self = shift;
- # max 2 parameter:
- # 1: the chunk
- # 2: the encoding of the string
- croak("parse_xml_chunk is not a class method! Create a parser object with XML::LibXML->new first!") unless ref $self;
- croak("parse already in progress") if $self->{_State_}; my $result;
-
- unless ( defined $_[0] and length $_[0] ) {
- croak("Empty String");
- }
-
- $self->{_State_} = 1;
-
- $self->_init_callbacks();
-
- if ( defined $self->{SAX} ) {
- eval {
- $self->_parse_sax_xml_chunk( @_ );
-
- # this is required for XML::GenericChunk.
- # in normal case is_filter is not defined, an thus the parsing
- # will be terminated. in case of a SAX filter the parsing is not
- # finished at that state. therefore we must not reset the parsing
- unless ( $self->{IS_FILTER} ) {
- $result = $self->{HANDLER}->end_document();
- }
- };
- }
- else {
- eval { $result = $self->_parse_xml_chunk( @_ ); };
- }
-
- $self->_cleanup_callbacks();
-
- my $err = $@;
- $self->{_State_} = 0;
- if ($err) {
- chomp $err;
- croak $err;
- }
-
- return $result;
-}
-
-sub parse_balanced_chunk {
- my $self = shift;
- $self->_init_callbacks();
- my $rv;
- eval {
- $rv = $self->parse_xml_chunk( @_ );
- };
- my $err = $@;
- $self->_cleanup_callbacks();
- if ( $err ) {
- chomp $err;
- croak $err;
- }
- return $rv
-}
-
-# java style
-sub processXIncludes {
- my $self = shift;
- my $doc = shift;
- my $opts = shift;
- my $options = $self->_parser_options($opts);
- if ( $self->{_State_} != 1 ) {
- $self->_init_callbacks();
- }
- my $rv;
- eval {
- $rv = $self->_processXIncludes($doc || " ", $options);
- };
- my $err = $@;
- if ( $self->{_State_} != 1 ) {
- $self->_cleanup_callbacks();
- }
-
- if ( $err ) {
- chomp $err;
- croak $err;
- }
- return $rv;
-}
-
-# perl style
-sub process_xincludes {
- my $self = shift;
- my $doc = shift;
- my $opts = shift;
- my $options = $self->_parser_options($opts);
-
- my $rv;
- $self->_init_callbacks();
- eval {
- $rv = $self->_processXIncludes($doc || " ", $options);
- };
- my $err = $@;
- $self->_cleanup_callbacks();
- if ( $err ) {
- chomp $err;
- croak $@;
- }
- return $rv;
-}
-
-#-------------------------------------------------------------------------#
-# HTML parsing functions #
-#-------------------------------------------------------------------------#
-
-sub _html_options {
- my ($self,$opts)=@_;
- $opts = {} unless ref $opts;
- # return (undef,undef) unless ref $opts;
- my $flags = 0;
- $flags |= 1 if exists $opts->{recover} ? $opts->{recover} : $self->recover;
- $flags |= 32 if $opts->{suppress_errors};
- $flags |= 64 if $opts->{suppress_warnings};
- $flags |= 128 if exists $opts->{pedantic_parser} ? $opts->{pedantic_parser} : $self->pedantic_parser;
- $flags |= 256 if exists $opts->{no_blanks} ? $opts->{no_blanks} : !$self->keep_blanks;
- $flags |= 2048 if exists $opts->{no_network} ? $opts->{no_network} : !$self->no_network;
- return ($opts->{URI},$opts->{encoding},$flags);
-}
-
-sub parse_html_string {
- my ($self,$str,$opts) = @_;
- croak("parse_html_string is not a class method! Create a parser object with XML::LibXML->new first!") unless ref $self;
- croak("parse already in progress") if $self->{_State_};
-
- unless ( defined $str and length $str ) {
- croak("Empty String");
- }
- $self->{_State_} = 1;
- my $result;
-
- $self->_init_callbacks();
- eval {
- $result = $self->_parse_html_string( $str,
- $self->_html_options($opts)
- );
- };
- my $err = $@;
- $self->{_State_} = 0;
- if ($err) {
- chomp $err;
- $self->_cleanup_callbacks();
- croak $err;
- }
-
- $self->_cleanup_callbacks();
-
- return $result;
-}
-
-sub parse_html_file {
- my ($self,$file,$opts) = @_;
- croak("parse_html_file is not a class method! Create a parser object with XML::LibXML->new first!") unless ref $self;
- croak("parse already in progress") if $self->{_State_};
- $self->{_State_} = 1;
- my $result;
-
- $self->_init_callbacks();
- eval { $result = $self->_parse_html_file($file,
- $self->_html_options($opts)
- ); };
- my $err = $@;
- $self->{_State_} = 0;
- if ($err) {
- chomp $err;
- $self->_cleanup_callbacks();
- croak $err;
- }
-
- $self->_cleanup_callbacks();
-
- return $result;
-}
-
-sub parse_html_fh {
- my ($self,$fh,$opts) = @_;
- croak("parse_html_fh is not a class method! Create a parser object with XML::LibXML->new first!") unless ref $self;
- croak("parse already in progress") if $self->{_State_};
- $self->{_State_} = 1;
-
- my $result;
- $self->_init_callbacks();
- eval { $result = $self->_parse_html_fh( $fh,
- $self->_html_options($opts)
- ); };
- my $err = $@;
- $self->{_State_} = 0;
- if ($err) {
- chomp $err;
- $self->_cleanup_callbacks();
- croak $err;
- }
- $self->_cleanup_callbacks();
-
- return $result;
-}
-
-#-------------------------------------------------------------------------#
-# push parser interface #
-#-------------------------------------------------------------------------#
-sub init_push {
- my $self = shift;
-
- if ( defined $self->{CONTEXT} ) {
- delete $self->{CONTEXT};
- }
-
- if ( defined $self->{SAX} ) {
- $self->{CONTEXT} = $self->_start_push(1);
- }
- else {
- $self->{CONTEXT} = $self->_start_push(0);
- }
-}
-
-sub push {
- my $self = shift;
-
- $self->_init_callbacks();
-
- if ( not defined $self->{CONTEXT} ) {
- $self->init_push();
- }
-
- eval {
- foreach ( @_ ) {
- $self->_push( $self->{CONTEXT}, $_ );
- }
- };
- my $err = $@;
- $self->_cleanup_callbacks();
- if ( $err ) {
- chomp $err;
- croak $err;
- }
-}
-
-# this function should be promoted!
-# the reason is because libxml2 uses xmlParseChunk() for this purpose!
-sub parse_chunk {
- my $self = shift;
- my $chunk = shift;
- my $terminate = shift;
-
- if ( not defined $self->{CONTEXT} ) {
- $self->init_push();
- }
-
- if ( defined $chunk and length $chunk ) {
- $self->_push( $self->{CONTEXT}, $chunk );
- }
-
- if ( $terminate ) {
- return $self->finish_push();
- }
-}
-
-
-sub finish_push {
- my $self = shift;
- my $restore = shift || 0;
- return undef unless defined $self->{CONTEXT};
-
- my $retval;
-
- if ( defined $self->{SAX} ) {
- eval {
- $self->_end_sax_push( $self->{CONTEXT} );
- $retval = $self->{HANDLER}->end_document( {} );
- };
- }
- else {
- eval { $retval = $self->_end_push( $self->{CONTEXT}, $restore ); };
- }
- delete $self->{CONTEXT};
- my $err = $@;
- if ( $err ) {
- chomp $err;
- croak( $err );
- }
- return $retval;
-}
-
-1;
-
-#-------------------------------------------------------------------------#
-# XML::LibXML::Node Interface #
-#-------------------------------------------------------------------------#
-package XML::LibXML::Node;
-
-sub isSupported {
- my $self = shift;
- my $feature = shift;
- return $self->can($feature) ? 1 : 0;
-}
-
-sub getChildNodes { my $self = shift; return $self->childNodes(); }
-
-sub childNodes {
- my $self = shift;
- my @children = $self->_childNodes();
- return wantarray ? @children : XML::LibXML::NodeList->new_from_ref(\@children , 1);
-}
-
-sub attributes {
- my $self = shift;
- my @attr = $self->_attributes();
- return wantarray ? @attr : XML::LibXML::NamedNodeMap->new( @attr );
-}
-
-
-sub findnodes {
- my ($node, $xpath) = @_;
- my @nodes = $node->_findnodes($xpath);
- if (wantarray) {
- return @nodes;
- }
- else {
- return XML::LibXML::NodeList->new_from_ref(\@nodes, 1);
- }
-}
-
-sub findvalue {
- my ($node, $xpath) = @_;
- my $res;
- eval {
- $res = $node->find($xpath);
- };
- if ( $@ ) {
- die $@;
- }
- return $res->to_literal->value;
-}
-
-sub find {
- my ($node, $xpath) = @_;
- my ($type, @params) = $node->_find($xpath);
- if ($type) {
- return $type->new(@params);
- }
- return undef;
-}
-
-sub setOwnerDocument {
- my ( $self, $doc ) = @_;
- $doc->adoptNode( $self );
-}
-
-sub toStringC14N {
- my ($self, $comments, $xpath) = (shift, shift, shift);
- return $self->_toStringC14N( $comments || 0,
- (defined $xpath ? $xpath : undef),
- 0,
- undef );
-}
-sub toStringEC14N {
- my ($self, $comments, $xpath, $inc_prefix_list) = @_;
- if (defined($inc_prefix_list) and !UNIVERSAL::isa($inc_prefix_list,'ARRAY')) {
- croak("toStringEC14N: inclusive_prefix_list must be undefined or ARRAY");
- }
- return $self->_toStringC14N( $comments || 0,
- (defined $xpath ? $xpath : undef),
- 1,
- (defined $inc_prefix_list ? $inc_prefix_list : undef));
-}
-
-*serialize_c14n = \&toStringC14N;
-*serialize_exc_c14n = \&toStringEC14N;
-
-1;
-
-#-------------------------------------------------------------------------#
-# XML::LibXML::Document Interface #
-#-------------------------------------------------------------------------#
-package XML::LibXML::Document;
-
-use vars qw(@ISA);
-@ISA = ('XML::LibXML::Node');
-
-sub actualEncoding {
- my $doc = shift;
- my $enc = $doc->encoding;
- return (defined $enc and length $enc) ? $enc : 'UTF-8';
-}
-
-sub setDocumentElement {
- my $doc = shift;
- my $element = shift;
-
- my $oldelem = $doc->documentElement;
- if ( defined $oldelem ) {
- $doc->removeChild($oldelem);
- }
-
- $doc->_setDocumentElement($element);
-}
-
-sub toString {
- my $self = shift;
- my $flag = shift;
-
- my $retval = "";
-
- if ( defined $XML::LibXML::skipXMLDeclaration
- and $XML::LibXML::skipXMLDeclaration == 1 ) {
- foreach ( $self->childNodes ){
- next if $_->nodeType == XML::LibXML::XML_DTD_NODE()
- and $XML::LibXML::skipDTD;
- $retval .= $_->toString;
- }
- }
- else {
- $flag ||= 0 unless defined $flag;
- $retval = $self->_toString($flag);
- }
-
- return $retval;
-}
-
-sub serialize {
- my $self = shift;
- return $self->toString( @_ );
-}
-
-#-------------------------------------------------------------------------#
-# bad style xinclude processing #
-#-------------------------------------------------------------------------#
-sub process_xinclude {
- my $self = shift;
- my $opts = shift;
- XML::LibXML->new->processXIncludes( $self, $opts );
-}
-
-sub insertProcessingInstruction {
- my $self = shift;
- my $target = shift;
- my $data = shift;
-
- my $pi = $self->createPI( $target, $data );
- my $root = $self->documentElement;
-
- if ( defined $root ) {
- # this is actually not correct, but i guess it's what the user
- # intends
- $self->insertBefore( $pi, $root );
- }
- else {
- # if no documentElement was found we just append the PI
- $self->appendChild( $pi );
- }
-}
-
-sub insertPI {
- my $self = shift;
- $self->insertProcessingInstruction( @_ );
-}
-
-#-------------------------------------------------------------------------#
-# DOM L3 Document functions.
-# added after robins implicit feature requst
-#-------------------------------------------------------------------------#
-*getElementsByTagName = \&XML::LibXML::Element::getElementsByTagName;
-*getElementsByTagNameNS = \&XML::LibXML::Element::getElementsByTagNameNS;
-*getElementsByLocalName = \&XML::LibXML::Element::getElementsByLocalName;
-
-1;
-
-#-------------------------------------------------------------------------#
-# XML::LibXML::DocumentFragment Interface #
-#-------------------------------------------------------------------------#
-package XML::LibXML::DocumentFragment;
-
-use vars qw(@ISA);
-@ISA = ('XML::LibXML::Node');
-
-sub toString {
- my $self = shift;
- my $retval = "";
- if ( $self->hasChildNodes() ) {
- foreach my $n ( $self->childNodes() ) {
- $retval .= $n->toString(@_);
- }
- }
- return $retval;
-}
-
-*serialize = \&toString;
-
-1;
-
-#-------------------------------------------------------------------------#
-# XML::LibXML::Element Interface #
-#-------------------------------------------------------------------------#
-package XML::LibXML::Element;
-
-use vars qw(@ISA);
-@ISA = ('XML::LibXML::Node');
-use XML::LibXML qw(:ns :libxml);
-use Carp;
-
-sub setNamespace {
- my $self = shift;
- my $n = $self->nodeName;
- if ( $self->_setNamespace(@_) ){
- if ( scalar @_ < 3 || $_[2] == 1 ){
- $self->setNodeName( $n );
- }
- return 1;
- }
- return 0;
-}
-
-sub getAttribute {
- my $self = shift;
- my $name = $_[0];
- if ( $name =~ /^xmlns(?::|$)/ ) {
- # user wants to get a namespace ...
- (my $prefix = $name )=~s/^xmlns:?//;
- $self->_getNamespaceDeclURI($prefix);
- }
- else {
- $self->_getAttribute(@_);
- }
-}
-
-sub setAttribute {
- my ( $self, $name, $value ) = @_;
- if ( $name =~ /^xmlns(?::|$)/ ) {
- # user wants to set the special attribute for declaring XML namespace ...
-
- # this is fine but not exactly DOM conformant behavior, btw (according to DOM we should
- # probably declare an attribute which looks like XML namespace declaration
- # but isn't)
- (my $nsprefix = $name )=~s/^xmlns:?//;
- my $nn = $self->nodeName;
- if ( $nn =~ /^\Q${nsprefix}\E:/ ) {
- # the element has the same prefix
- $self->setNamespaceDeclURI($nsprefix,$value) ||
- $self->setNamespace($value,$nsprefix,1);
- ##
- ## We set the namespace here.
- ## This is helpful, as in:
- ##
- ## | $e = XML::LibXML::Element->new('foo:bar');
- ## | $e->setAttribute('xmlns:foo','http://yoyodine')
- ##
- }
- else {
- # just modify the namespace
- $self->setNamespaceDeclURI($nsprefix, $value) ||
- $self->setNamespace($value,$nsprefix,0);
- }
- }
- else {
- $self->_setAttribute($name, $value);
- }
-}
-
-sub getAttributeNS {
- my $self = shift;
- my ($nsURI, $name) = @_;
- croak("invalid attribute name") if !defined($name) or $name eq q{};
- if ( defined($nsURI) and $nsURI eq XML_XMLNS_NS ) {
- $self->_getNamespaceDeclURI($name eq 'xmlns' ? undef : $name);
- }
- else {
- $self->_getAttributeNS(@_);
- }
-}
-
-sub setAttributeNS {
- my ($self, $nsURI, $qname, $value)=@_;
- unless (defined $qname and length $qname) {
- croak("bad name");
- }
- if (defined($nsURI) and $nsURI eq XML_XMLNS_NS) {
- if ($qname !~ /^xmlns(?::|$)/) {
- croak("NAMESPACE ERROR: Namespace declartions must have the prefix 'xmlns'");
- }
- $self->setAttribute($qname,$value); # see implementation above
- return;
- }
- if ($qname=~/:/ and not (defined($nsURI) and length($nsURI))) {
- croak("NAMESPACE ERROR: Attribute without a prefix cannot be in a namespace");
- }
- if ($qname=~/^xmlns(?:$|:)/) {
- croak("NAMESPACE ERROR: 'xmlns' prefix and qualified-name are reserved for the namespace ".XML_XMLNS_NS);
- }
- if ($qname=~/^xml:/ and not (defined $nsURI and $nsURI eq XML_XML_NS)) {
- croak("NAMESPACE ERROR: 'xml' prefix is reserved for the namespace ".XML_XML_NS);
- }
- $self->_setAttributeNS( defined $nsURI ? $nsURI : undef, $qname, $value );
-}
-
-sub getElementsByTagName {
- my ( $node , $name ) = @_;
- my $xpath = $name eq '*' ? "descendant::*" : "descendant::*[name()='$name']";
- my @nodes = $node->_findnodes($xpath);
- return wantarray ? @nodes : XML::LibXML::NodeList->new_from_ref(\@nodes, 1);
-}
-
-sub getElementsByTagNameNS {
- my ( $node, $nsURI, $name ) = @_;
- my $xpath;
- if ( $name eq '*' ) {
- if ( $nsURI eq '*' ) {
- $xpath = "descendant::*";
- } else {
- $xpath = "descendant::*[namespace-uri()='$nsURI']";
- }
- } elsif ( $nsURI eq '*' ) {
- $xpath = "descendant::*[local-name()='$name']";
- } else {
- $xpath = "descendant::*[local-name()='$name' and namespace-uri()='$nsURI']";
- }
- my @nodes = $node->_findnodes($xpath);
- return wantarray ? @nodes : XML::LibXML::NodeList->new_from_ref(\@nodes, 1);
-}
-
-sub getElementsByLocalName {
- my ( $node,$name ) = @_;
- my $xpath;
- if ($name eq '*') {
- $xpath = "descendant::*";
- } else {
- $xpath = "descendant::*[local-name()='$name']";
- }
- my @nodes = $node->_findnodes($xpath);
- return wantarray ? @nodes : XML::LibXML::NodeList->new_from_ref(\@nodes, 1);
-}
-
-sub getChildrenByTagName {
- my ( $node, $name ) = @_;
- my @nodes;
- if ($name eq '*') {
- @nodes = grep { $_->nodeType == XML_ELEMENT_NODE() }
- $node->childNodes();
- } else {
- @nodes = grep { $_->nodeName eq $name } $node->childNodes();
- }
- return wantarray ? @nodes : XML::LibXML::NodeList->new_from_ref(\@nodes, 1);
-}
-
-sub getChildrenByLocalName {
- my ( $node, $name ) = @_;
- my @nodes;
- if ($name eq '*') {
- @nodes = grep { $_->nodeType == XML_ELEMENT_NODE() }
- $node->childNodes();
- } else {
- @nodes = grep { $_->nodeType == XML_ELEMENT_NODE() and
- $_->localName eq $name } $node->childNodes();
- }
- return wantarray ? @nodes : XML::LibXML::NodeList->new_from_ref(\@nodes, 1);
-}
-
-sub getChildrenByTagNameNS {
- my ( $node, $nsURI, $name ) = @_;
- my @nodes = $node->_getChildrenByTagNameNS($nsURI,$name);
- return wantarray ? @nodes : XML::LibXML::NodeList->new_from_ref(\@nodes, 1);
-}
-
-sub appendWellBalancedChunk {
- my ( $self, $chunk ) = @_;
-
- my $local_parser = XML::LibXML->new();
- my $frag = $local_parser->parse_xml_chunk( $chunk );
-
- $self->appendChild( $frag );
-}
-
-1;
-
-#-------------------------------------------------------------------------#
-# XML::LibXML::Text Interface #
-#-------------------------------------------------------------------------#
-package XML::LibXML::Text;
-
-use vars qw(@ISA);
-@ISA = ('XML::LibXML::Node');
-
-sub attributes { return undef; }
-
-sub deleteDataString {
- my $node = shift;
- my $string = shift;
- my $all = shift;
- my $data = $node->nodeValue();
- $string =~ s/([\\\*\+\^\{\}\&\?\[\]\(\)\$\%\@])/\\$1/g;
- if ( $all ) {
- $data =~ s/$string//g;
- }
- else {
- $data =~ s/$string//;
- }
- $node->setData( $data );
-}
-
-sub replaceDataString {
- my ( $node, $left, $right,$all ) = @_;
-
- #ashure we exchange the strings and not expressions!
- $left =~ s/([\\\*\+\^\{\}\&\?\[\]\(\)\$\%\@])/\\$1/g;
- my $datastr = $node->nodeValue();
- if ( $all ) {
- $datastr =~ s/$left/$right/g;
- }
- else{
- $datastr =~ s/$left/$right/;
- }
- $node->setData( $datastr );
-}
-
-sub replaceDataRegEx {
- my ( $node, $leftre, $rightre, $flags ) = @_;
- return unless defined $leftre;
- $rightre ||= "";
-
- my $datastr = $node->nodeValue();
- my $restr = "s/" . $leftre . "/" . $rightre . "/";
- $restr .= $flags if defined $flags;
-
- eval '$datastr =~ '. $restr;
-
- $node->setData( $datastr );
-}
-
-1;
-
-package XML::LibXML::Comment;
-
-use vars qw(@ISA);
-@ISA = ('XML::LibXML::Text');
-
-1;
-
-package XML::LibXML::CDATASection;
-
-use vars qw(@ISA);
-@ISA = ('XML::LibXML::Text');
-
-1;
-
-#-------------------------------------------------------------------------#
-# XML::LibXML::Attribute Interface #
-#-------------------------------------------------------------------------#
-package XML::LibXML::Attr;
-use vars qw( @ISA ) ;
-@ISA = ('XML::LibXML::Node') ;
-
-sub setNamespace {
- my ($self,$href,$prefix) = @_;
- my $n = $self->nodeName;
- if ( $self->_setNamespace($href,$prefix) ) {
- $self->setNodeName($n);
- return 1;
- }
-
- return 0;
-}
-
-1;
-
-#-------------------------------------------------------------------------#
-# XML::LibXML::Dtd Interface #
-#-------------------------------------------------------------------------#
-# this is still under construction
-#
-package XML::LibXML::Dtd;
-use vars qw( @ISA );
-@ISA = ('XML::LibXML::Node');
-
-1;
-
-#-------------------------------------------------------------------------#
-# XML::LibXML::PI Interface #
-#-------------------------------------------------------------------------#
-package XML::LibXML::PI;
-use vars qw( @ISA );
-@ISA = ('XML::LibXML::Node');
-
-sub setData {
- my $pi = shift;
-
- my $string = "";
- if ( scalar @_ == 1 ) {
- $string = shift;
- }
- else {
- my %h = @_;
- $string = join " ", map {$_.'="'.$h{$_}.'"'} keys %h;
- }
-
- # the spec says any char but "?>" [17]
- $pi->_setData( $string ) unless $string =~ /\?>/;
-}
-
-1;
-
-#-------------------------------------------------------------------------#
-# XML::LibXML::Namespace Interface #
-#-------------------------------------------------------------------------#
-package XML::LibXML::Namespace;
-
-# this is infact not a node!
-sub prefix { return "xmlns"; }
-sub getPrefix { return "xmlns"; }
-sub getNamespaceURI { return "http://www.w3.org/2000/xmlns/" };
-
-sub getNamespaces { return (); }
-
-sub nodeName {
- my $self = shift;
- my $nsP = $self->localname;
- return ( defined($nsP) && length($nsP) ) ? "xmlns:$nsP" : "xmlns";
-}
-sub name { goto &nodeName }
-sub getName { goto &nodeName }
-
-sub isEqualNode {
- my ( $self, $ref ) = @_;
- if ( ref($ref) eq "XML::LibXML::Namespace" ) {
- return $self->_isEqual($ref);
- }
- return 0;
-}
-
-sub isSameNode {
- my ( $self, $ref ) = @_;
- if ( $$self == $$ref ){
- return 1;
- }
- return 0;
-}
-
-1;
-
-#-------------------------------------------------------------------------#
-# XML::LibXML::NamedNodeMap Interface #
-#-------------------------------------------------------------------------#
-package XML::LibXML::NamedNodeMap;
-
-use XML::LibXML::Common qw(:libxml);
-
-sub new {
- my $class = shift;
- my $self = bless { Nodes => [@_] }, $class;
- $self->{NodeMap} = { map { $_->nodeName => $_ } @_ };
- return $self;
-}
-
-sub length { return scalar( @{$_[0]->{Nodes}} ); }
-sub nodes { return $_[0]->{Nodes}; }
-sub item { $_[0]->{Nodes}->[$_[1]]; }
-
-sub getNamedItem {
- my $self = shift;
- my $name = shift;
-
- return $self->{NodeMap}->{$name};
-}
-
-sub setNamedItem {
- my $self = shift;
- my $node = shift;
-
- my $retval;
- if ( defined $node ) {
- if ( scalar @{$self->{Nodes}} ) {
- my $name = $node->nodeName();
- if ( $node->nodeType() == XML_NAMESPACE_DECL ) {
- return;
- }
- if ( defined $self->{NodeMap}->{$name} ) {
- if ( $node->isSameNode( $self->{NodeMap}->{$name} ) ) {
- return;
- }
- $retval = $self->{NodeMap}->{$name}->replaceNode( $node );
- }
- else {
- $self->{Nodes}->[0]->addSibling($node);
- }
-
- $self->{NodeMap}->{$name} = $node;
- push @{$self->{Nodes}}, $node;
- }
- else {
- # not done yet
- # can this be properly be done???
- warn "not done yet\n";
- }
- }
- return $retval;
-}
-
-sub removeNamedItem {
- my $self = shift;
- my $name = shift;
- my $retval;
- if ( $name =~ /^xmlns/ ) {
- warn "not done yet\n";
- }
- elsif ( exists $self->{NodeMap}->{$name} ) {
- $retval = $self->{NodeMap}->{$name};
- $retval->unbindNode;
- delete $self->{NodeMap}->{$name};
- $self->{Nodes} = [grep {not($retval->isSameNode($_))} @{$self->{Nodes}}];
- }
-
- return $retval;
-}
-
-sub getNamedItemNS {
- my $self = shift;
- my $nsURI = shift;
- my $name = shift;
- return undef;
-}
-
-sub setNamedItemNS {
- my $self = shift;
- my $nsURI = shift;
- my $node = shift;
- return undef;
-}
-
-sub removeNamedItemNS {
- my $self = shift;
- my $nsURI = shift;
- my $name = shift;
- return undef;
-}
-
-1;
-
-package XML::LibXML::_SAXParser;
-
-# this is pseudo class!!! and it will be removed as soon all functions
-# moved to XS level
-
-use XML::SAX::Exception;
-
-# these functions will use SAX exceptions as soon i know how things really work
-sub warning {
- my ( $parser, $message, $line, $col ) = @_;
- my $error = XML::SAX::Exception::Parse->new( LineNumber => $line,
- ColumnNumber => $col,
- Message => $message, );
- $parser->{HANDLER}->warning( $error );
-}
-
-sub error {
- my ( $parser, $message, $line, $col ) = @_;
-
- my $error = XML::SAX::Exception::Parse->new( LineNumber => $line,
- ColumnNumber => $col,
- Message => $message, );
- $parser->{HANDLER}->error( $error );
-}
-
-sub fatal_error {
- my ( $parser, $message, $line, $col ) = @_;
- my $error = XML::SAX::Exception::Parse->new( LineNumber => $line,
- ColumnNumber => $col,
- Message => $message, );
- $parser->{HANDLER}->fatal_error( $error );
-}
-
-1;
-
-package XML::LibXML::RelaxNG;
-
-sub new {
- my $class = shift;
- my %args = @_;
-
- my $self = undef;
- if ( defined $args{location} ) {
- $self = $class->parse_location( $args{location} );
- }
- elsif ( defined $args{string} ) {
- $self = $class->parse_buffer( $args{string} );
- }
- elsif ( defined $args{DOM} ) {
- $self = $class->parse_document( $args{DOM} );
- }
-
- return $self;
-}
-
-1;
-
-package XML::LibXML::Schema;
-
-sub new {
- my $class = shift;
- my %args = @_;
-
- my $self = undef;
- if ( defined $args{location} ) {
- $self = $class->parse_location( $args{location} );
- }
- elsif ( defined $args{string} ) {
- $self = $class->parse_buffer( $args{string} );
- }
-
- return $self;
-}
-
-1;
-
-#-------------------------------------------------------------------------#
-# XML::LibXML::InputCallback Interface #
-#-------------------------------------------------------------------------#
-package XML::LibXML::InputCallback;
-
-use vars qw($_CUR_CB @_GLOBAL_CALLBACKS @_CB_STACK);
-
-$_CUR_CB = undef;
-
-@_GLOBAL_CALLBACKS = ();
-@_CB_STACK = ();
-
-#-------------------------------------------------------------------------#
-# global callbacks #
-#-------------------------------------------------------------------------#
-sub _callback_match {
- my $uri = shift;
- my $retval = 0;
-
- # loop through the callbacks and and find the first matching
- # The callbacks are stored in execution order (reverse stack order)
- # any new global callbacks are shifted to the callback stack.
- foreach my $cb ( @_GLOBAL_CALLBACKS ) {
-
- # callbacks have to return 1, 0 or undef, while 0 and undef
- # are handled the same way.
- # in fact, if callbacks return other values, the global match
- # assumes silently that the callback failed.
-
- $retval = $cb->[0]->($uri);
-
- if ( defined $retval and $retval == 1 ) {
- # make the other callbacks use this callback
- $_CUR_CB = $cb;
- unshift @_CB_STACK, $cb;
- last;
- }
- }
-
- return $retval;
-}
-
-sub _callback_open {
- my $uri = shift;
- my $retval = undef;
-
- # the open callback has to return a defined value.
- # if one works on files this can be a file handle. But
- # depending on the needs of the callback it also can be a
- # database handle or a integer labeling a certain dataset.
-
- if ( defined $_CUR_CB ) {
- $retval = $_CUR_CB->[1]->( $uri );
-
- # reset the callbacks, if one callback cannot open an uri
- if ( not defined $retval or $retval == 0 ) {
- shift @_CB_STACK;
- $_CUR_CB = $_CB_STACK[0];
- }
- }
-
- return $retval;
-}
-
-sub _callback_read {
- my $fh = shift;
- my $buflen = shift;
-
- my $retval = undef;
-
- if ( defined $_CUR_CB ) {
- $retval = $_CUR_CB->[2]->( $fh, $buflen );
- }
-
- return $retval;
-}
-
-sub _callback_close {
- my $fh = shift;
- my $retval = 0;
-
- if ( defined $_CUR_CB ) {
- $retval = $_CUR_CB->[3]->( $fh );
- shift @_CB_STACK;
- $_CUR_CB = $_CB_STACK[0];
- }
-
- return $retval;
-}
-
-#-------------------------------------------------------------------------#
-# member functions and methods #
-#-------------------------------------------------------------------------#
-
-sub new {
- my $CLASS = shift;
- return bless {'_CALLBACKS' => []}, $CLASS;
-}
-
-# add a callback set to the callback stack
-# synopsis: $icb->register_callbacks( [$match_cb, $open_cb, $read_cb, $close_cb] );
-sub register_callbacks {
- my $self = shift;
- my $cbset = shift;
-
- # test if callback set is complete
- if ( ref $cbset eq "ARRAY" and scalar( @$cbset ) == 4 ) {
- unshift @{$self->{_CALLBACKS}}, $cbset;
- }
-}
-
-# remove a callback set to the callback stack
-# if a callback set is passed, this function will check for the match function
-sub unregister_callbacks {
- my $self = shift;
- my $cbset = shift;
- if ( ref $cbset eq "ARRAY" and scalar( @$cbset ) == 4 ) {
- $self->{_CALLBACKS} = [grep { $_->[0] != $cbset->[0] } @{$self->{_CALLBACKS}}];
- }
- else {
- shift @{$self->{_CALLBACKS}};
- }
-}
-
-# make libxml2 use the callbacks
-sub init_callbacks {
- my $self = shift;
-
- $_CUR_CB = undef;
- @_CB_STACK = ();
-
- @_GLOBAL_CALLBACKS = @{ $self->{_CALLBACKS} };
-
- if ( defined $XML::LibXML::match_cb and
- defined $XML::LibXML::open_cb and
- defined $XML::LibXML::read_cb and
- defined $XML::LibXML::close_cb ) {
- push @_GLOBAL_CALLBACKS, [$XML::LibXML::match_cb,
- $XML::LibXML::open_cb,
- $XML::LibXML::read_cb,
- $XML::LibXML::close_cb];
- }
-
- $self->lib_init_callbacks();
-}
-
-# reset libxml2's callbacks
-sub cleanup_callbacks {
- my $self = shift;
-
- $_CUR_CB = undef;
- @_GLOBAL_CALLBACKS = ();
- @_CB_STACK = ();
-
- $self->lib_cleanup_callbacks();
-}
-
-1;
-
-__END__
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML.pod b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML.pod
deleted file mode 100644
index f4f59f9e518..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML.pod
+++ /dev/null
@@ -1,433 +0,0 @@
-=head1 NAME
-
-XML::LibXML - Perl Binding for libxml2
-
-=head1 SYNOPSIS
-
-
-
- use XML::LibXML;
- my $parser = XML::LibXML->new();
-
- my $doc = $parser->parse_string(<<'EOT');
- <some-xml/>
- EOT
-
- $Version_String = XML::LibXML::LIBXML_DOTTED_VERSION;
- $Version_ID = XML::LibXML::LIBXML_VERSION;
- $DLL_Version = XML::LibXML::LIBXML_RUNTIME_VERSION;
- $libxmlnode = XML::LibXML->import_GDOME( $node, $deep );
- $gdomenode = XML::LibXML->export_GDOME( $node, $deep );
-
-=head1 DESCRIPTION
-
-This module is an interface to libxml2, providing XML and HTML parsers with
-DOM, SAX and XMLReader interfaces, a large subset of DOM Layer 3 interface and
-a XML::XPath-like interface to XPath API of libxml2. The module is split into
-several packages which are not described in this section; unless stated
-otherwise, you only need to C<<<<<< use XML::LibXML; >>>>>> in your programs.
-
-For further information, please check the following documentation:
-
-=over 4
-
-=item B<>
-
-Parsing XML Files with XML::LibXML
-
-
-=item B<>
-
-XML::LibXML DOM Implementation
-
-
-=item B<>
-
-XML::LibXML direct SAX parser
-
-
-=item B<>
-
-Reading XML with a pull-parser
-
-
-=item B<>
-
-XML::LibXML DOM Document Class
-
-
-=item B<>
-
-Abstract Base Class of XML::LibXML Nodes
-
-
-=item B<>
-
-XML::LibXML Class for Element Nodes
-
-
-=item B<>
-
-XML::LibXML Class for Text Nodes
-
-
-=item B<>
-
-XML::LibXML Comment Nodes
-
-
-=item B<>
-
-XML::LibXML Class for CDATA Sections
-
-
-=item B<>
-
-XML::LibXML Attribute Class
-
-
-=item B<>
-
-XML::LibXML's DOM L2 Document Fragment Implementation
-
-
-=item B<>
-
-XML::LibXML Namespace Implementation
-
-
-=item B<>
-
-XML::LibXML Processing Instructions
-
-
-=item B<>
-
-XML::LibXML DTD Support
-
-
-=item B<>
-
-XML::LibXML frontend for RelaxNG schema validation
-
-
-=item B<>
-
-XML::LibXML frontend for W3C Schema schema validation
-
-
-=item B<>
-
-API for evaluating XPath expressions with enhanced support for the evaluation
-context
-
-
-
-=back
-
-
-=head1 ENCODINGS SUPPORT IN XML::LIBXML
-
-Recall that since version 5.6.1, Perl distinguishes between character strings
-(internally encoded in UTF-8) and so called binary data and, accordingly,
-applies either character or byte semantics to them. A scalar representing a
-character string is distinguished from a byte string by special flag (UTF8).
-Please refer to I<<<<<< perlunicode >>>>>> for details.
-
-XML::LibXML's API is designed to deal with many encodings of XML documents
-completely transparently, so that the application using XML::LibXML can be
-completely ignorant about the encoding of the XML documents it works with. On
-the other hand, functions like C<<<<<< XML::LibXML::Document->setEncoding >>>>>> give the user control over the document encoding.
-
-To ensure the aforementioned transparency and uniformity, most functions of
-XML::LibXML that work with in-memory trees accept and return data as character
-strings (i.e. UTF-8 encoded with the UTF8 flag on) regardless of the original
-document encoding; however, the functions related to I/O operations (i.e.
-parsing and saving) operate with binary data (in the original document
-encoding) obeying the encoding declaration of the XML documents.
-
-Below we summarize basic rules and principles regarding encoding:
-
-
-=over 4
-
-=item 1.
-
-Do NOT apply any encoding-related PerlIO layers (C<<<<<< :utf8 >>>>>> or C<<<<<< :encoding(...) >>>>>>) to file handles that are an imput for the parses or an ouptut for a
-serializer of (full) XML documents. This is because the conversion of the data
-to/from the internal character representation is provided by libxml2 itself
-which must be able to enforce the encoding specified by the C<<<<<< <?xml version="1.0" encoding="..."?> >>>>>> declaration. Here is an example to follow:
-
- use XML::LibXML;
- my $parser = XML::LibXML->new;
- open my $fh, "file.xml";
- binmode $fh; # drop all PerlIO layers possibly created by a use open pragma
- $doc = $parser->parse_fh($fh);
- open my $out, "out.xml";
- binmode $fh; # as above
- $doc->toFh($fh);
- # or
- print $fh $doc->toString();
-
-
-
-
-
-=item 2.
-
-All functions working with DOM accept and return character strings (UTF-8
-encoded with UTF8 flag on). E.g.
-
- my $doc = XML::LibXML:Document->new('1.0',$some_encoding);
- my $element = $doc->createElement($name);
- $element->appendText($text);
- $xml_fragment = $element->toString(); # returns a character string
- $xml_document = $doc->toString(); # returns a byte string
-
-where C<<<<<< $some_encoding >>>>>> is the document encoding that will be used when saving the document, and C<<<<<< $name >>>>>> and C<<<<<< $text >>>>>> contain character strings (UTF-8 encoded with UTF8 flag on). Note that the
-method C<<<<<< toString >>>>>> returns XML as a character string if applied to other node than the Document
-node and a byte string containing the apropriate
-
- <?xml version="1.0" encoding="..."?>
-
-declaration if appliled to a L<<<<<< XML::LibXML DOM Document Class|XML::LibXML DOM Document Class >>>>>>.
-
-
-
-=item 3.
-
-DOM methods also accept binary strings in the original encoding of the document
-to which the node belongs (UTF-8 is assumed if the node is not attached to any
-document). Exploiting this feature is NOT RECOMMENDED since it is considered a
-bad practice.
-
-
-
- my $doc = XML::LibXML:Document->new('1.0','iso-8859-2');
- my $text = $doc->createTextNode($some_latin2_encoded_byte_string);
- # WORKS, BUT NOT RECOMMENDED!
-
-
-
-=back
-
-I<<<<<< NOTE: >>>>>> libxml2 support for many encodings is based on the iconv library. The actual
-list of supported encodings may vary from platform to platform. To test if your
-platform works correctly with your language encoding, build a simple document
-in the particular encoding and try to parse it with XML::LibXML to see if the
-parser produces any errors. Occasional crashes were reported on rare platforms
-that ship with a broken version of iconv.
-
-
-=head1 VERSION INFORMATION
-
-Sometimes it is useful to figure out, for which version XML::LibXML was
-compiled for. In most cases this is for debugging or to check if a given
-installation meets all functionality for the package. The functions
-XML::LibXML::LIBXML_DOTTED_VERSION and XML::LibXML::LIBXML_VERSION provide this
-version information. Both functions simply pass through the values of the
-similar named macros of libxml2. Similarly, XML::LibXML::LIBXML_RUNTIME_VERSION
-returns the version of the (usually dynamically) linked libxml2.
-
-=over 4
-
-=item B<XML::LibXML::LIBXML_DOTTED_VERSION>
-
- $Version_String = XML::LibXML::LIBXML_DOTTED_VERSION;
-
-Returns the version string of the libxml2 version XML::LibXML was compiled for.
-This will be "2.6.2" for "libxml2 2.6.2".
-
-
-=item B<XML::LibXML::LIBXML_VERSION>
-
- $Version_ID = XML::LibXML::LIBXML_VERSION;
-
-Returns the version id of the libxml2 version XML::LibXML was compiled for.
-This will be "20602" for "libxml2 2.6.2". Don't mix this version id with
-$XML::LibXML::VERSION. The latter contains the version of XML::LibXML itself
-while the first contains the version of libxml2 XML::LibXML was compiled for.
-
-
-=item B<XML::LibXML::LIBXML_RUNTIME_VERSION>
-
- $DLL_Version = XML::LibXML::LIBXML_RUNTIME_VERSION;
-
-Returns a version string of the libxml2 which is (usually dynamically) linked
-by XML::LibXML. This will be "20602" for libxml2 released as "2.6.2" and
-something like "20602-CVS2032" for a CVS build of libxml2.
-
-XML::LibXML issues a warning if the version of libxml2 dynamically linked to it
-is less than the version of libxml2 which it was compiled against.
-
-
-
-=back
-
-
-=head1 EXPORTS
-
-By default the module exports all constants and functions listed in the :all
-tag, described below.
-
-
-=head1 EXPORT TAGS
-
-=over 4
-
-=item B<:all>
-
-Includes the tags C<<<<<< :libxml >>>>>>, C<<<<<< :encoding >>>>>>, and C<<<<<< :ns >>>>>> described below.
-
-
-=item B<:libxml>
-
-Exports integer constants for DOM node types (defined in a separately
-distributed XML::LibXML::Common module).
-
-
-
- XML_ELEMENT_NODE => 1
- XML_ATTRIBUTE_NODE => 2
- XML_TEXT_NODE => 3
- XML_CDATA_SECTION_NODE => 4
- XML_ENTITY_REF_NODE => 5
- XML_ENTITY_NODE => 6
- XML_PI_NODE => 7
- XML_COMMENT_NODE => 8
- XML_DOCUMENT_NODE => 9
- XML_DOCUMENT_TYPE_NODE => 10
- XML_DOCUMENT_FRAG_NODE => 11
- XML_NOTATION_NODE => 12
- XML_HTML_DOCUMENT_NODE => 13
- XML_DTD_NODE => 14
- XML_ELEMENT_DECL => 15
- XML_ATTRIBUTE_DECL => 16
- XML_ENTITY_DECL => 17
- XML_NAMESPACE_DECL => 18
- XML_XINCLUDE_START => 19
- XML_XINCLUDE_END => 20
-
-
-=item B<:encoding>
-
-Exports two encoding conversion functions from the (separate) module
-XML::LibXML::Common.
-
-
-
- encodeToUTF8()
- decodeFromUTF8()
-
-
-=item B<:libxml>
-
-Exports two convenience constants: the implicit namespace of the reserved C<<<<<< xml: >>>>>> prefix, and the implicit namespace for the reserved C<<<<<< xmlns: >>>>>> prefix.
-
-
-
- XML_XML_NS => 'http://www.w3.org/XML/1998/namespace'
- XML_XMLNS_NS => 'http://www.w3.org/2000/xmlns/'
-
-
-
-=back
-
-
-=head1 RELATED MODULES
-
-The modules described in this section are not part of the XML::LibXML package
-itself. As they support some additional features, they are mentioned here.
-
-=over 4
-
-=item B<XML::LibXSLT>
-
-XSLT 1.0 Processor using libxslt and XML::LibXML
-
-
-=item B<XML::LibXML::Common>
-
-Common functions for XML::LibXML related Classes
-
-
-=item B<XML::LibXML::Iterator>
-
-XML::LibXML Implementation of the DOM Traversal Specification
-
-
-
-=back
-
-
-=head1 XML::LIBXML AND XML::GDOME
-
-Note: I<<<<<< THE FUNCTIONS DESCRIBED HERE ARE STILL EXPERIMENTAL >>>>>>
-
-Although both modules make use of libxml2's XML capabilities, the DOM
-implementation of both modules are not compatible. But still it is possible to
-exchange nodes from one DOM to the other. The concept of this exchange is
-pretty similar to the function cloneNode(): The particular node is copied on
-the low-level to the opposite DOM implementation.
-
-Since the DOM implementations cannot coexist within one document, one is forced
-to copy each node that should be used. Because you are always keeping two nodes
-this may cause quite an impact on a machines memory usage.
-
-XML::LibXML provides two functions to export or import GDOME nodes:
-import_GDOME() and export_GDOME(). Both function have two parameters: the node
-and a flag for recursive import. The flag works as in cloneNode().
-
-The two functions allow to export and import XML::GDOME nodes explicitly,
-however, XML::LibXML allows also the transparent import of XML::GDOME nodes in
-functions such as appendChild(), insertAfter() and so on. While native nodes
-are automatically adopted in most functions XML::GDOME nodes are always cloned
-in advance. Thus if the original node is modified after the operation, the node
-in the XML::LibXML document will not have this information.
-
-=over 4
-
-=item B<import_GDOME>
-
- $libxmlnode = XML::LibXML->import_GDOME( $node, $deep );
-
-This clones an XML::GDOME node to a XML::LibXML node explicitly.
-
-
-=item B<export_GDOME>
-
- $gdomenode = XML::LibXML->export_GDOME( $node, $deep );
-
-Allows to clone an XML::LibXML node into a XML::GDOME node.
-
-
-
-=back
-
-
-=head1 CONTACTS
-
-For bug reports, please use the CPAN request tracker on
-http://rt.cpan.org/NoAuth/Bugs.html?Dist=XML-LibXML
-
-For suggestions etc., and other issues related to XML::LibXML you may use the
-perl XML mailing list (C<<<<<< perl-xml@listserv.ActiveState.com >>>>>>), where most XML-related Perl modules are discussed. In case of problems you
-should check the archives of that list first. Many problems are already
-discussed there. You can find the list's archives and subscription options at L<<<<<< http://aspn.activestate.com/ASPN/Mail/Browse/Threaded/perl-xml|http://aspn.activestate.com/ASPN/Mail/Browse/Threaded/perl-xml >>>>>>.
-
-=head1 AUTHORS
-
-Matt Sergeant,
-Christian Glahn,
-Petr Pajas
-
-
-=head1 VERSION
-
-1.66
-
-=head1 COPYRIGHT
-
-2001-2007, AxKit.com Ltd; 2002-2006 Christian Glahn; 2006-2008 Petr Pajas, All rights reserved.
-
-=cut
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/Attr.pod b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/Attr.pod
deleted file mode 100644
index d20d4234163..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/Attr.pod
+++ /dev/null
@@ -1,130 +0,0 @@
-=head1 NAME
-
-XML::LibXML::Attr - XML::LibXML Attribute Class
-
-=head1 SYNOPSIS
-
-
-
- use XML::LibXML;
- # Only methods specific to Attribute nodes are listed here,
- # see XML::LibXML::Node manpage for other methods
-
- $attr = XML::LibXML::Attr->new($name [,$value]);
- $string = $attr->getValue();
- $string = $attr->value;
- $attr->setValue( $string );
- $node = $attr->getOwnerElement();
- $attr->setNamespace($nsURI, $prefix);
- $bool = $attr->isId;
- $string = $attr->serializeContent;
-
-=head1 DESCRIPTION
-
-This is the interface to handle Attributes like ordinary nodes. The naming of
-the class relies on the W3C DOM documentation.
-
-
-=head1 METHODS
-
-The class inherits from L<<<<<< Abstract Base Class of XML::LibXML Nodes|Abstract Base Class of XML::LibXML Nodes >>>>>>. The documentation for Inherited methods is not listed here.
-
-Many functions listed here are extensively documented in the L<<<<<< DOM Level 3 specification|http://www.w3.org/TR/DOM-Level-3-Core/ >>>>>>. Please refer to the specification for extensive documentation.
-
-=over 4
-
-=item B<new>
-
- $attr = XML::LibXML::Attr->new($name [,$value]);
-
-Class constructor. If you need to work with ISO encoded strings, you should I<<<<<< always >>>>>> use the C<<<<<< createAttrbute >>>>>> of L<<<<<< XML::LibXML DOM Document Class|XML::LibXML DOM Document Class >>>>>>.
-
-
-=item B<getValue>
-
- $string = $attr->getValue();
-
-Returns the value stored for the attribute. If undef is returned, the attribute
-has no value, which is different of being C<<<<<< not specified >>>>>>.
-
-
-=item B<value>
-
- $string = $attr->value;
-
-Alias for I<<<<<< getValue() >>>>>>
-
-
-=item B<setValue>
-
- $attr->setValue( $string );
-
-This is needed to set a new attribute value. If ISO encoded strings are passed
-as parameter, the node has to be bound to a document, otherwise the encoding
-might be done incorrectly.
-
-
-=item B<getOwnerElement>
-
- $node = $attr->getOwnerElement();
-
-returns the node the attribute belongs to. If the attribute is not bound to a
-node, undef will be returned. Overwriting the underlying implementation, the I<<<<<< parentNode >>>>>> function will return undef, instead of the owner element.
-
-
-=item B<setNamespace>
-
- $attr->setNamespace($nsURI, $prefix);
-
-This function tries to bound the attribute to a given namespace. If C<<<<<< $nsURI >>>>>> is undefined or empty, the function discards any previous association of the
-attribute with a namespace. If the namespace was not previously declared in the
-context of the attribute, this function will fail. In this case you may wish to
-call setNamespace() on the ownerElement. If the namespace URI is non-empty and
-declared in the context of the attribute, but only with a different (non-empty)
-prefix, then the attribute is still bound to the namespace but gets a different
-prefix than C<<<<<< $prefix >>>>>>. The function also fails if the prefix is empty but the namespace URI is not
-(because unprefixed attributes should by definition belong to no namespace).
-This function returns 1 on success, 0 otherwise.
-
-
-=item B<isId>
-
- $bool = $attr->isId;
-
-Determine whether an attribute is of type ID. For documents with a DTD, this
-information is only available if DTD loading/validation has been requested. For
-HTML documents parsed with the HTML parser ID detection is done automatically.
-In XML documents, all "xml:id" attributes are considered to be of type ID.
-
-
-=item B<serializeContent($docencoding)>
-
- $string = $attr->serializeContent;
-
-This function is not part of DOM API. It returns attribute content in the form
-in which it serializes into XML, that is with all meta-characters properly
-quoted and with raw entity references (except for entities expanded during
-parse time). Setting the optional $docencoding flag to 1 enforces document
-encoding for the output string (which is then passed to Perl as a byte string).
-Otherwise the string is passed to Perl as (UTF-8 encoded) characters.
-
-
-
-=back
-
-=head1 AUTHORS
-
-Matt Sergeant,
-Christian Glahn,
-Petr Pajas
-
-
-=head1 VERSION
-
-1.66
-
-=head1 COPYRIGHT
-
-2001-2007, AxKit.com Ltd; 2002-2006 Christian Glahn; 2006-2008 Petr Pajas, All rights reserved.
-
-=cut
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/Boolean.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/Boolean.pm
deleted file mode 100644
index 23352ffd0cc..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/Boolean.pm
+++ /dev/null
@@ -1,85 +0,0 @@
-# $Id: Boolean.pm 709 2008-01-29 21:01:32Z pajas $
-# Copyright 2001-2002, AxKit.com Ltd. All rights reserved.
-
-package XML::LibXML::Boolean;
-use XML::LibXML::Number;
-use XML::LibXML::Literal;
-use strict;
-
-use vars qw ($VERSION);
-
-$VERSION = "1.66"; # VERSION TEMPLATE: DO NOT CHANGE
-
-use overload
- '""' => \&value,
- '<=>' => \&cmp;
-
-sub new {
- my $class = shift;
- my ($param) = @_;
- my $val = $param ? 1 : 0;
- bless \$val, $class;
-}
-
-sub True {
- my $class = shift;
- my $val = 1;
- bless \$val, $class;
-}
-
-sub False {
- my $class = shift;
- my $val = 0;
- bless \$val, $class;
-}
-
-sub value {
- my $self = shift;
- $$self;
-}
-
-sub cmp {
- my $self = shift;
- my ($other, $swap) = @_;
- if ($swap) {
- return $other <=> $$self;
- }
- return $$self <=> $other;
-}
-
-sub to_number { XML::LibXML::Number->new($_[0]->value); }
-sub to_boolean { $_[0]; }
-sub to_literal { XML::LibXML::Literal->new($_[0]->value ? "true" : "false"); }
-
-sub string_value { return $_[0]->to_literal->value; }
-
-1;
-__END__
-
-=head1 NAME
-
-XML::LibXML::Boolean - Boolean true/false values
-
-=head1 DESCRIPTION
-
-XML::LibXML::Boolean objects implement simple boolean true/false objects.
-
-=head1 API
-
-=head2 XML::LibXML::Boolean->True
-
-Creates a new Boolean object with a true value.
-
-=head2 XML::LibXML::Boolean->False
-
-Creates a new Boolean object with a false value.
-
-=head2 value()
-
-Returns true or false.
-
-=head2 to_literal()
-
-Returns the string "true" or "false".
-
-=cut
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/CDATASection.pod b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/CDATASection.pod
deleted file mode 100644
index 3776c2335d7..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/CDATASection.pod
+++ /dev/null
@@ -1,54 +0,0 @@
-=head1 NAME
-
-XML::LibXML::CDATASection - XML::LibXML Class for CDATA Sections
-
-=head1 SYNOPSIS
-
-
-
- use XML::LibXML;
- # Only methods specific to CDATA nodes are listed here,
- # see XML::LibXML::Node manpage for other methods
-
- $node = XML::LibXML::CDATASection( $content );
-
-=head1 DESCRIPTION
-
-This class provides all functions of L<<<<<< XML::LibXML Class for Text Nodes|XML::LibXML Class for Text Nodes >>>>>>, but for CDATA nodes.
-
-
-=head1 METHODS
-
-The class inherits from L<<<<<< Abstract Base Class of XML::LibXML Nodes|Abstract Base Class of XML::LibXML Nodes >>>>>>. The documentation for Inherited methods is not listed here.
-
-Many functions listed here are extensively documented in the L<<<<<< DOM Level 3 specification|http://www.w3.org/TR/DOM-Level-3-Core/ >>>>>>. Please refer to the specification for extensive documentation.
-
-=over 4
-
-=item B<new>
-
- $node = XML::LibXML::CDATASection( $content );
-
-The constructor is the only provided function for this package. It is required,
-because I<<<<<< libxml2 >>>>>> treats the different text node types slightly differently.
-
-
-
-=back
-
-=head1 AUTHORS
-
-Matt Sergeant,
-Christian Glahn,
-Petr Pajas
-
-
-=head1 VERSION
-
-1.66
-
-=head1 COPYRIGHT
-
-2001-2007, AxKit.com Ltd; 2002-2006 Christian Glahn; 2006-2008 Petr Pajas, All rights reserved.
-
-=cut
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/Comment.pod b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/Comment.pod
deleted file mode 100644
index 2e6af2f63ab..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/Comment.pod
+++ /dev/null
@@ -1,55 +0,0 @@
-=head1 NAME
-
-XML::LibXML::Comment - XML::LibXML Comment Class
-
-=head1 SYNOPSIS
-
-
-
- use XML::LibXML;
- # Only methods specific to Comment nodes are listed here,
- # see XML::LibXML::Node manpage for other methods
-
- $node = XML::LibXML::Comment( $content );
-
-=head1 DESCRIPTION
-
-This class provides all functions of L<<<<<< XML::LibXML Class for Text Nodes|XML::LibXML Class for Text Nodes >>>>>>, but for comment nodes. This can be done, since only the output of the node
-types is different, but not the data structure. :-)
-
-
-=head1 METHODS
-
-The class inherits from L<<<<<< Abstract Base Class of XML::LibXML Nodes|Abstract Base Class of XML::LibXML Nodes >>>>>>. The documentation for Inherited methods is not listed here.
-
-Many functions listed here are extensively documented in the L<<<<<< DOM Level 3 specification|http://www.w3.org/TR/DOM-Level-3-Core/ >>>>>>. Please refer to the specification for extensive documentation.
-
-=over 4
-
-=item B<new>
-
- $node = XML::LibXML::Comment( $content );
-
-The constructor is the only provided function for this package. It is required,
-because I<<<<<< libxml2 >>>>>> treats text nodes and comment nodes slightly differently.
-
-
-
-=back
-
-=head1 AUTHORS
-
-Matt Sergeant,
-Christian Glahn,
-Petr Pajas
-
-
-=head1 VERSION
-
-1.66
-
-=head1 COPYRIGHT
-
-2001-2007, AxKit.com Ltd; 2002-2006 Christian Glahn; 2006-2008 Petr Pajas, All rights reserved.
-
-=cut
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/Common.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/Common.pm
deleted file mode 100644
index 4c571ad861f..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/Common.pm
+++ /dev/null
@@ -1,306 +0,0 @@
-#-------------------------------------------------------------------------#
-# $Id: Common.pm,v 1.5 2003/02/27 18:32:59 phish108 Exp $
-#-------------------------------------------------------------------------#
-package XML::LibXML::Common;
-
-#-------------------------------------------------------------------------#
-# global blur #
-#-------------------------------------------------------------------------#
-use strict;
-
-require Exporter;
-require DynaLoader;
-use vars qw( @ISA $VERSION @EXPORT @EXPORT_OK %EXPORT_TAGS);
-
-@ISA = qw(DynaLoader Exporter);
-
-$VERSION = '0.13';
-
-bootstrap XML::LibXML::Common $VERSION;
-
-#-------------------------------------------------------------------------#
-# export information #
-#-------------------------------------------------------------------------#
-%EXPORT_TAGS = (
- all => [qw(
- ELEMENT_NODE
- ATTRIBUTE_NODE
- TEXT_NODE
- CDATA_SECTION_NODE
- ENTITY_REFERENCE_NODE
- ENTITY_NODE
- PI_NODE
- PROCESSING_INSTRUCTION_NODE
- COMMENT_NODE
- DOCUMENT_NODE
- DOCUMENT_TYPE_NODE
- DOCUMENT_FRAG_NODE
- DOCUMENT_FRAGMENT_NODE
- NOTATION_NODE
- HTML_DOCUMENT_NODE
- DTD_NODE
- ELEMENT_DECLARATION
- ATTRIBUTE_DECLARATION
- ENTITY_DECLARATION
- NAMESPACE_DECLARATION
- XINCLUDE_END
- XINCLUDE_START
- encodeToUTF8
- decodeFromUTF8
- )],
- w3c => [qw(
- ELEMENT_NODE
- ATTRIBUTE_NODE
- TEXT_NODE
- CDATA_SECTION_NODE
- ENTITY_REFERENCE_NODE
- ENTITY_NODE
- PI_NODE
- PROCESSING_INSTRUCTION_NODE
- COMMENT_NODE
- DOCUMENT_NODE
- DOCUMENT_TYPE_NODE
- DOCUMENT_FRAG_NODE
- DOCUMENT_FRAGMENT_NODE
- NOTATION_NODE
- HTML_DOCUMENT_NODE
- DTD_NODE
- ELEMENT_DECLARATION
- ATTRIBUTE_DECLARATION
- ENTITY_DECLARATION
- NAMESPACE_DECLARATION
- XINCLUDE_END
- XINCLUDE_START
- )],
- libxml => [qw(
- XML_ELEMENT_NODE
- XML_ATTRIBUTE_NODE
- XML_TEXT_NODE
- XML_CDATA_SECTION_NODE
- XML_ENTITY_REF_NODE
- XML_ENTITY_NODE
- XML_PI_NODE
- XML_COMMENT_NODE
- XML_DOCUMENT_NODE
- XML_DOCUMENT_TYPE_NODE
- XML_DOCUMENT_FRAG_NODE
- XML_NOTATION_NODE
- XML_HTML_DOCUMENT_NODE
- XML_DTD_NODE
- XML_ELEMENT_DECL
- XML_ATTRIBUTE_DECL
- XML_ENTITY_DECL
- XML_NAMESPACE_DECL
- XML_XINCLUDE_END
- XML_XINCLUDE_START
- )],
- gdome => [qw(
- GDOME_ELEMENT_NODE
- GDOME_ATTRIBUTE_NODE
- GDOME_TEXT_NODE
- GDOME_CDATA_SECTION_NODE
- GDOME_ENTITY_REF_NODE
- GDOME_ENTITY_NODE
- GDOME_PI_NODE
- GDOME_COMMENT_NODE
- GDOME_DOCUMENT_NODE
- GDOME_DOCUMENT_TYPE_NODE
- GDOME_DOCUMENT_FRAG_NODE
- GDOME_NOTATION_NODE
- GDOME_HTML_DOCUMENT_NODE
- GDOME_DTD_NODE
- GDOME_ELEMENT_DECL
- GDOME_ATTRIBUTE_DECL
- GDOME_ENTITY_DECL
- GDOME_NAMESPACE_DECL
- GDOME_XINCLUDE_END
- GDOME_XINCLUDE_START
- )],
- encoding => [qw(
- encodeToUTF8
- decodeFromUTF8
- )],
- );
-
-@EXPORT_OK = (
- @{$EXPORT_TAGS{encoding}},
- @{$EXPORT_TAGS{w3c}},
- @{$EXPORT_TAGS{libxml}},
- @{$EXPORT_TAGS{gdome}},
- );
-
-@EXPORT = (
- @{$EXPORT_TAGS{encoding}},
- @{$EXPORT_TAGS{w3c}},
- );
-
-#-------------------------------------------------------------------------#
-# W3 conform node types #
-#-------------------------------------------------------------------------#
-use constant ELEMENT_NODE => 1;
-use constant ATTRIBUTE_NODE => 2;
-use constant TEXT_NODE => 3;
-use constant CDATA_SECTION_NODE => 4;
-use constant ENTITY_REFERENCE_NODE => 5;
-use constant ENTITY_NODE => 6;
-use constant PROCESSING_INSTRUCTION_NODE => 7;
-use constant COMMENT_NODE => 8;
-use constant DOCUMENT_NODE => 9;
-use constant DOCUMENT_TYPE_NODE => 10;
-use constant DOCUMENT_FRAGMENT_NODE => 11;
-use constant NOTATION_NODE => 12;
-use constant HTML_DOCUMENT_NODE => 13;
-use constant DTD_NODE => 14;
-use constant ELEMENT_DECLARATION => 15;
-use constant ATTRIBUTE_DECLARATION => 16;
-use constant ENTITY_DECLARATION => 17;
-use constant NAMESPACE_DECLARATION => 18;
-
-#-------------------------------------------------------------------------#
-# some extras for the W3 spec
-#-------------------------------------------------------------------------#
-use constant PI_NODE => 7;
-use constant DOCUMENT_FRAG_NODE => 11;
-use constant XINCLUDE_END => 19;
-use constant XINCLUDE_START => 20;
-
-#-------------------------------------------------------------------------#
-# libxml2 compat names #
-#-------------------------------------------------------------------------#
-use constant XML_ELEMENT_NODE => 1;
-use constant XML_ATTRIBUTE_NODE => 2;
-use constant XML_TEXT_NODE => 3;
-use constant XML_CDATA_SECTION_NODE => 4;
-use constant XML_ENTITY_REF_NODE => 5;
-use constant XML_ENTITY_NODE => 6;
-use constant XML_PI_NODE => 7;
-use constant XML_COMMENT_NODE => 8;
-use constant XML_DOCUMENT_NODE => 9;
-use constant XML_DOCUMENT_TYPE_NODE => 10;
-use constant XML_DOCUMENT_FRAG_NODE => 11;
-use constant XML_NOTATION_NODE => 12;
-use constant XML_HTML_DOCUMENT_NODE => 13;
-use constant XML_DTD_NODE => 14;
-use constant XML_ELEMENT_DECL => 15;
-use constant XML_ATTRIBUTE_DECL => 16;
-use constant XML_ENTITY_DECL => 17;
-use constant XML_NAMESPACE_DECL => 18;
-use constant XML_XINCLUDE_START => 19;
-use constant XML_XINCLUDE_END => 20;
-
-#-------------------------------------------------------------------------#
-# libgdome compat names #
-#-------------------------------------------------------------------------#
-use constant GDOME_ELEMENT_NODE => 1;
-use constant GDOME_ATTRIBUTE_NODE => 2;
-use constant GDOME_TEXT_NODE => 3;
-use constant GDOME_CDATA_SECTION_NODE => 4;
-use constant GDOME_ENTITY_REF_NODE => 5;
-use constant GDOME_ENTITY_NODE => 6;
-use constant GDOME_PI_NODE => 7;
-use constant GDOME_COMMENT_NODE => 8;
-use constant GDOME_DOCUMENT_NODE => 9;
-use constant GDOME_DOCUMENT_TYPE_NODE => 10;
-use constant GDOME_DOCUMENT_FRAG_NODE => 11;
-use constant GDOME_NOTATION_NODE => 12;
-use constant GDOME_HTML_DOCUMENT_NODE => 13;
-use constant GDOME_DTD_NODE => 14;
-use constant GDOME_ELEMENT_DECL => 15;
-use constant GDOME_ATTRIBUTE_DECL => 16;
-use constant GDOME_ENTITY_DECL => 17;
-use constant GDOME_NAMESPACE_DECL => 18;
-use constant GDOME_XINCLUDE_START => 19;
-use constant GDOME_XINCLUDE_END => 20;
-
-1;
-#-------------------------------------------------------------------------#
-__END__
-
-=head1 NAME
-
-XML::LibXML::Common - Routines and Constants common for XML::LibXML and XML::GDOME
-
-=head1 SYNOPSIS
-
- use XML::LibXML::Common;
-
-=head1 DESCRIPTION
-
-XML::LibXML and XML::GDOME share some of the same functionality. This
-package should bundle some shared constansts and functions, so both
-modules may coexist within the same scripts.
-
-XML::LibXML::Common defines all node types as constants. While
-XML::LibXML and XML::GDOME originally declared their own node type
-definitions, one may want to use XML::LibXML::Common in its
-compatibility mode:
-
-=over 4
-
-=item * use XML::LibXML::Common qw(:libxml);
-
-:libxml will use the XML::LibXML Compatibility mode, which defines the
-old 'XML_' node-type definitions
-
-=item * use XML::LibXML::Common qw(:gdome);
-
-This allows one to use the XML::LibXML Compatibility mode, which
-defines the old 'GDOME_' node-type definitions
-
-=item * use XML::LibXML::Common qw(:w3c);
-
-This uses the nodetype definition names as specified for DOM.
-
-=item * use XML::LibXML::Common qw(:encoding);
-
-This is ment if only the encoding functions of XML::LibXML::Common
-should be used.
-
-=back
-
-By default the W3 definitions as defined in the DOM specifications and
-the encoding functions are exported by XML::LibXML::Common.
-
-=head2 encoding functions
-
-To encode or decode a string to or from UTF-8 XML::LibXML::Common exports
-two functions, which use the encoding mechanism of the underlaying
-implementation. These functions should be used, if external encoding
-is required (e.g. for queryfunctions).
-
-=head2 encodeToUTF8
-
- $encodedstring = encodeToUTF8( $name_of_encoding, $sting_to_encode );
-
-The function will encode a string from the specified encoding to UTF-8.
-
-=head2 decodeFromUTF8
-
- $decodedstring = decodeFromUTF8($name_of_encoding, $string_to_decode );
-
-This Function transforms an UTF-8 encoded string the specified
-encoding. While transforms to ISO encodings may cause errors if the
-given stirng contains unsupported characters, both functions can
-transform to UTF-16 encodings as well.
-
-Note that both encoding functions report their errors on the standard
-error. If an error occours the function will croak(). To catch the
-error information it is required to call the encoding function from
-within an eval block to avoid a script to stop.
-
-=head1 AUTHOR
-
-Christian Glahn, (christian.glahn@uibk.ac.at) Innsbruck University
-
-=head1 COPYRIGHT
-
-(c) 2002 Christian Glahn. 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<perl>, L<XML::LibXML>, L<XML::GDOME>
-
-=cut
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/DOM.pod b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/DOM.pod
deleted file mode 100644
index 921a504cf49..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/DOM.pod
+++ /dev/null
@@ -1,139 +0,0 @@
-=head1 NAME
-
-XML::LibXML::DOM - XML::LibXML DOM Implementation
-
-
-=head1 DESCRIPTION
-
-XML::LibXML provides an light-wight interface to I<<<<<< modify >>>>>> a node of the document tree generated by the XML::LibXML parser. This interface
-follows as far as possible the DOM Level 3 specification. Additionally to the
-specified functions the XML::LibXML supports some functions that are more handy
-to use in the perl environment.
-
-One also has to remember, that XML::LibXML is an interface to libxml2 nodes
-which actually reside on the C-Level of XML::LibXML. This means each node is a
-reference to a structure different than a perl hash or array. The only way to
-access these structure's values is through the DOM interface provided by
-XML::LibXML. This also means, that one I<<<<<< can't >>>>>> simply inherit a XML::LibXML node and add new member variables as they were
-hash keys.
-
-The DOM interface of XML::LibXML does not intend to implement a full DOM
-interface as it is done by XML::GDOME and used for full featured application.
-Moreover, it offers an simple way to build or modify documents that are created
-by XML::LibXML's parser.
-
-Another target of the XML::LibXML interface is to make the interfaces of
-libxml2 available to the perl community. This includes also some workarounds to
-some features where libxml2 assumes more control over the C-Level that most
-perl users don't have.
-
-One of the most important parts of the XML::LibXML DOM interface is, that the
-interfaces try do follow the L<<<<<< DOM Level 3 specification|http://www.w3.org/TR/DOM-Level-3-Core/ >>>>>> rather strictly. This means the interface functions are named as the DOM
-specification says and not what widespread Java interfaces claim to be
-standard. Although there are several functions that have only a singular
-interface that conforms to the DOM spec XML::LibXML provides an additional Java
-style alias interface.
-
-Also there are some function interfaces left over from early stages of
-XML::LibXML for compatibility reasons. These interfaces are for compatibility
-reasons I<<<<<< only >>>>>>. They might disappear in one of the future versions of XML::LibXML, so a user
-is requested to switch over to the official functions.
-
-
-=head2 Encodings and XML::LibXML's DOM implementation
-
-See the section on Encodings in the I<<<<<< XML::LibXML >>>>>> manual page.
-
-
-=head2 Namespaces and XML::LibXML's DOM implementation
-
-XML::LibXML's DOM implementation is limited by the DOM implementation of
-libxml2 which treats namespaces slightly differently than required by the DOM
-Level 2 specification.
-
-According to the DOM Level 2 specification, namespaces of elements and
-attributes should be persistent, and nodes should be permanently bound to
-namespace URIs as they get created; it should be possible to manipulate the
-special attributes used for declaring XML namespaces just as other attributes
-without affecting the namespaces of other nodes. In DOM Level 2, the
-application is responsible for creating the special attributes consistently
-and/or for correct serialization of the document.
-
-This is both inconvenient, causes problems in serialization of DOM to XML, and
-most importantly, seems almost impossible to implement over libxml2.
-
-In libxml2, namespace URI and prefix of a node is provided by a pointer to a
-namespace declaration (appearing as a special xmlns attribute in the XML
-document). If the prefix or namespace URI of the declaration changes, the
-prefix and namespace URI of all nodes that point to it changes as well.
-Moreover, in contrast to DOM, a node (element or attribute) can only be bound
-to a namespace URI if there is some namespace declaration in the document to
-point to.
-
-Therefore current DOM implementation in XML::LibXML tries to treat namespace
-declarations in a compromise between reason, common sense, limitations of
-libxml2, and the DOM Level 2 specification.
-
-In XML::LibXML, special attributes declaring XML namespaces are often created
-automatically, usually when a namespaced node is attached to a document and no
-existing declaration of the namespace and prefix is in the scope to be reused.
-In this respect, XML::LibXML DOM implementation differs from the DOM Level 2
-specification according to which special attributes for declaring the
-appropriate XML namespaces should not be added when a node with a namespace
-prefix and namespace URI is created.
-
-Namespace declarations are also created when L<<<<<< XML::LibXML DOM Document Class|XML::LibXML DOM Document Class >>>>>>'s createElementNS() or createAttributeNS() function are used. If the a
-namespace is not declared on the documentElement, the namespace will be locally
-declared for the newly created node. In case of Attributes this may look a bit
-confusing, since these nodes cannot have namespace declarations itself. In this
-case the namespace is internally applied to the attribute and later declared on
-the node the attribute is appended to (if required).
-
-The following example may explain this a bit:
-
-
-
- my $doc = XML::LibXML->createDocument;
- my $root = $doc->createElementNS( "", "foo" );
- $doc->setDocumentElement( $root );
-
- my $attr = $doc->createAttributeNS( "bar", "bar:foo", "test" );
- $root->setAttributeNodeNS( $attr );
-
-This piece of code will result in the following document:
-
-
-
- <?xml version="1.0"?>
- <foo xmlns:bar="bar" bar:foo="test"/>
-
-The namespace is declared on the document element during the
-setAttributeNodeNS() call.
-
-Namespaces can be also declared explicitly by the use of XML::LibXML:Element's
-setNamespace() function. Since 1.61, they can also be manipulated with
-functions setNamespaceDeclPrefix() and setNamespaceDeclURI() (not available in
-DOM). Changing an URI or prefix of an existing namespace declaration affects
-the namespace URI and prefix of all nodes which point to it (that is the nodes
-in its scope).
-
-It is also important to repeat the specification: While working with namespaces
-you should use the namespace aware functions instead of the simplified
-versions. For example you should I<<<<<< never >>>>>> use setAttribute() but setAttributeNS().
-
-=head1 AUTHORS
-
-Matt Sergeant,
-Christian Glahn,
-Petr Pajas
-
-
-=head1 VERSION
-
-1.66
-
-=head1 COPYRIGHT
-
-2001-2007, AxKit.com Ltd; 2002-2006 Christian Glahn; 2006-2008 Petr Pajas, All rights reserved.
-
-=cut
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/Document.pod b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/Document.pod
deleted file mode 100644
index 02c7a0dfe18..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/Document.pod
+++ /dev/null
@@ -1,675 +0,0 @@
-=head1 NAME
-
-XML::LibXML::Document - XML::LibXML DOM Document Class
-
-=head1 SYNOPSIS
-
-
-
- use XML::LibXML;
- # Only methods specific to Document nodes are listed here,
- # see XML::LibXML::Node manpage for other methods
-
- $dom = XML::LibXML::Document->new( $version, $encoding );
- $dom = XML::LibXML::Document->createDocument( $version, $encoding );
- $strEncoding = $doc->encoding();
- $strEncoding = $doc->actualEncoding();
- $doc->setEncoding($new_encoding);
- $strVersion = $doc->version();
- $doc->standalone
- $doc->setStandalone($numvalue);
- my $compression = $doc->compression;
- $doc->setCompression($ziplevel);
- $docstring = $dom->toString($format);
- $c14nstr = $doc->toStringC14N($comment_flag,$xpath);
- $ec14nstr = $doc->toStringEC14N($inclusive_prefix_list, $comment_flag,$xpath);
- $str = $doc->serialize($format);
- $c14nstr = $doc->serialize_c14n($comment_flag,$xpath);
- $ec14nstr = $doc->serialize_exc_c14n($comment_flag,$xpath,$inclusive_prefix_list);
- $state = $doc->toFile($filename, $format);
- $state = $doc->toFH($fh, $format);
- $str = $document->toStringHTML();
- $str = $document->serialize_html();
- $bool = $dom->is_valid();
- $dom->validate();
- $root = $dom->documentElement();
- $dom->setDocumentElement( $root );
- $element = $dom->createElement( $nodename );
- $element = $dom->createElementNS( $namespaceURI, $qname );
- $text = $dom->createTextNode( $content_text );
- $comment = $dom->createComment( $comment_text );
- $attrnode = $doc->createAttribute($name [,$value]);
- $attrnode = $doc->createAttributeNS( namespaceURI, $name [,$value] );
- $fragment = $doc->createDocumentFragment();
- $cdata = $dom->create( $cdata_content );
- my $pi = $doc->createProcessingInstruction( $target, $data );
- my $entref = $doc->createEntityReference($refname);
- $dtd = $document->createInternalSubset( $rootnode, $public, $system);
- $dtd = $document->createExternalSubset( $rootnode_name, $publicId, $systemId);
- $document->importNode( $node );
- $document->adoptNode( $node );
- my $dtd = $doc->externalSubset;
- my $dtd = $doc->internalSubset;
- $doc->setExternalSubset($dtd);
- $doc->setInternalSubset($dtd);
- my $dtd = $doc->removeExternalSubset();
- my $dtd = $doc->removeInternalSubset();
- my @nodelist = $doc->getElementsByTagName($tagname);
- my @nodelist = $doc->getElementsByTagNameNS($nsURI,$tagname);
- my @nodelist = $doc->getElementsByLocalName($localname);
- my $node = $doc->getElementById($id);
- $dom->indexElements();
-
-=head1 DESCRIPTION
-
-The Document Class is in most cases the result of a parsing process. But
-sometimes it is necessary to create a Document from scratch. The DOM Document
-Class provides functions that conform to the DOM Core naming style.
-
-It inherits all functions from L<<<<<< Abstract Base Class of XML::LibXML Nodes|Abstract Base Class of XML::LibXML Nodes >>>>>> as specified in the DOM specification. This enables access to the nodes besides
-the root element on document level - a C<<<<<< DTD >>>>>> for example. The support for these nodes is limited at the moment.
-
-While generally nodes are bound to a document in the DOM concept it is
-suggested that one should always create a node not bound to any document. There
-is no need of really including the node to the document, but once the node is
-bound to a document, it is quite safe that all strings have the correct
-encoding. If an unbound text node with an ISO encoded string is created (e.g.
-with $CLASS->new()), the C<<<<<< toString >>>>>> function may not return the expected result.
-
-To prevent such problems, it is recommended to pass all data to XML::LibXML
-methods as character strings (i.e. UTF-8 encoded, with the UTF8 flag on).
-
-
-=head1 METHODS
-
-Many functions listed here are extensively documented in the L<<<<<< DOM Level 3 specification|http://www.w3.org/TR/DOM-Level-3-Core/ >>>>>>. Please refer to the specification for extensive documentation.
-
-=over 4
-
-=item B<new>
-
- $dom = XML::LibXML::Document->new( $version, $encoding );
-
-alias for createDocument()
-
-
-=item B<createDocument>
-
- $dom = XML::LibXML::Document->createDocument( $version, $encoding );
-
-The constructor for the document class. As Parameter it takes the version
-string and (optionally) the encoding string. Simply calling I<<<<<< createDocument >>>>>>() will create the document:
-
-
-
- <?xml version="your version" encoding="your encoding"?>
-
-Both parameter are optional. The default value for I<<<<<< $version >>>>>> is C<<<<<< 1.0 >>>>>>, of course. If the I<<<<<< $encoding >>>>>> parameter is not set, the encoding will be left unset, which means UTF-8 is
-implied.
-
-The call of I<<<<<< createDocument >>>>>>() without any parameter will result the following code:
-
-
-
- <?xml version="1.0"?>
-
-Alternatively one can call this constructor directly from the XML::LibXML class
-level, to avoid some typing. This will not have any effect on the class
-instance, which is always XML::LibXML::Document.
-
-
-
- my $document = XML::LibXML->createDocument( "1.0", "UTF-8" );
-
-is therefore a shortcut for
-
-
-
- my $document = XML::LibXML::Document->createDocument( "1.0", "UTF-8" );
-
-
-=item B<encoding>
-
- $strEncoding = $doc->encoding();
-
-returns the encoding string of the document.
-
-
-
- my $doc = XML::LibXML->createDocument( "1.0", "ISO-8859-15" );
- print $doc->encoding; # prints ISO-8859-15
-
-
-=item B<actualEncoding>
-
- $strEncoding = $doc->actualEncoding();
-
-returns the encoding in which the XML will be returned by $doc->toString().
-This is usually the original encoding of the document as declared in the XML
-declaration and returned by $doc->encoding. If the original encoding is not
-known (e.g. if created in memory or parsed from a XML without a declared
-encoding), 'UTF-8' is returned.
-
-
-
- my $doc = XML::LibXML->createDocument( "1.0", "ISO-8859-15" );
- print $doc->encoding; # prints ISO-8859-15
-
-
-=item B<setEncoding>
-
- $doc->setEncoding($new_encoding);
-
-This method allows to change the declaration of encoding in the XML declaration
-of the document. The value also affects the encoding in which the document is
-serialized to XML by $doc->toString(). Use setEncoding() to remove the encoding
-declaration.
-
-
-=item B<version>
-
- $strVersion = $doc->version();
-
-returns the version string of the document
-
-I<<<<<< getVersion() >>>>>> is an alternative form of this function.
-
-
-=item B<standalone>
-
- $doc->standalone
-
-This function returns the Numerical value of a documents XML declarations
-standalone attribute. It returns I<<<<<< 1 >>>>>> if standalone="yes" was found, I<<<<<< 0 >>>>>> if standalone="no" was found and I<<<<<< -1 >>>>>> if standalone was not specified (default on creation).
-
-
-=item B<setStandalone>
-
- $doc->setStandalone($numvalue);
-
-Through this method it is possible to alter the value of a documents standalone
-attribute. Set it to I<<<<<< 1 >>>>>> to set standalone="yes", to I<<<<<< 0 >>>>>> to set standalone="no" or set it to I<<<<<< -1 >>>>>> to remove the standalone attribute from the XML declaration.
-
-
-=item B<compression>
-
- my $compression = $doc->compression;
-
-libxml2 allows reading of documents directly from gzipped files. In this case
-the compression variable is set to the compression level of that file (0-8). If
-XML::LibXML parsed a different source or the file wasn't compressed, the
-returned value will be I<<<<<< -1 >>>>>>.
-
-
-=item B<setCompression>
-
- $doc->setCompression($ziplevel);
-
-If one intends to write the document directly to a file, it is possible to set
-the compression level for a given document. This level can be in the range from
-0 to 8. If XML::LibXML should not try to compress use I<<<<<< -1 >>>>>> (default).
-
-Note that this feature will I<<<<<< only >>>>>> work if libxml2 is compiled with zlib support and toFile() is used for output.
-
-
-=item B<toString>
-
- $docstring = $dom->toString($format);
-
-I<<<<<< toString >>>>>> is a DOM serializing function, so the DOM Tree is serialized into a XML string,
-ready for output.
-
-IMPORTANT: unlike toString for other nodes, on document nodes this function
-returns the XML as a byte string in the original encoding of the document (see
-the actualEncoding() method)! This means you can simply do:
-
-
-
- open OUT, $file;
- print OUT $doc->toString;
-
-regardless of the actual encoding of the document. See the section on encodings
-in L<<<<<< Perl Binding for libxml2|Perl Binding for libxml2 >>>>>> for more details.
-
-The optional I<<<<<< $format >>>>>> parameter sets the indenting of the output. This parameter is expected to be an C<<<<<< integer >>>>>> value, that specifies that indentation should be used. The format parameter can
-have three different values if it is used:
-
-If $format is 0, than the document is dumped as it was originally parsed
-
-If $format is 1, libxml2 will add ignorable white spaces, so the nodes content
-is easier to read. Existing text nodes will not be altered
-
-If $format is 2 (or higher), libxml2 will act as $format == 1 but it add a
-leading and a trailing line break to each text node.
-
-libxml2 uses a hard-coded indentation of 2 space characters per indentation
-level. This value can not be altered on run-time.
-
-
-=item B<toStringC14N>
-
- $c14nstr = $doc->toStringC14N($comment_flag,$xpath);
-
-See the documentation in L<<<<<< Abstract Base Class of XML::LibXML Nodes|Abstract Base Class of XML::LibXML Nodes >>>>>>.
-
-
-=item B<toStringEC14N>
-
- $ec14nstr = $doc->toStringEC14N($inclusive_prefix_list, $comment_flag,$xpath);
-
-See the documentation in L<<<<<< Abstract Base Class of XML::LibXML Nodes|Abstract Base Class of XML::LibXML Nodes >>>>>>.
-
-
-=item B<serialize>
-
- $str = $doc->serialize($format);
-
-An alias for toString(). This function was name added to be more consistent
-with libxml2.
-
-
-=item B<serialize_c14n>
-
- $c14nstr = $doc->serialize_c14n($comment_flag,$xpath);
-
-An alias for toStringC14N().
-
-
-=item B<serialize_exc_c14n>
-
- $ec14nstr = $doc->serialize_exc_c14n($comment_flag,$xpath,$inclusive_prefix_list);
-
-An alias for toStringEC14N().
-
-
-=item B<toFile>
-
- $state = $doc->toFile($filename, $format);
-
-This function is similar to toString(), but it writes the document directly
-into a filesystem. This function is very useful, if one needs to store large
-documents.
-
-The format parameter has the same behaviour as in toString().
-
-
-=item B<toFH>
-
- $state = $doc->toFH($fh, $format);
-
-This function is similar to toString(), but it writes the document directly to
-a filehandle or a stream. A byte stream in the document encoding is passed to
-the file handle. Do NOT apply any C<<<<<< :encoding(...) >>>>>> or C<<<<<< :utf8 >>>>>> PerlIO layer to the filehandle! See the section on encodings in L<<<<<< Perl Binding for libxml2|Perl Binding for libxml2 >>>>>> for more details.
-
-The format parameter has the same behaviour as in toString().
-
-
-=item B<toStringHTML>
-
- $str = $document->toStringHTML();
-
-I<<<<<< toStringHTML >>>>>> serialize the tree to a byte string in the document encoding as HTML. With this
-method indenting is automatic and managed by libxml2 internally.
-
-
-=item B<serialize_html>
-
- $str = $document->serialize_html();
-
-An alias for toStringHTML().
-
-
-=item B<is_valid>
-
- $bool = $dom->is_valid();
-
-Returns either TRUE or FALSE depending on whether the DOM Tree is a valid
-Document or not.
-
-You may also pass in a L<<<<<< XML::LibXML DTD Handling|XML::LibXML DTD Handling >>>>>> object, to validate against an external DTD:
-
-
-
- if (!$dom->is_valid($dtd)) {
- warn("document is not valid!");
- }
-
-
-=item B<validate>
-
- $dom->validate();
-
-This is an exception throwing equivalent of is_valid. If the document is not
-valid it will throw an exception containing the error. This allows you much
-better error reporting than simply is_valid or not.
-
-Again, you may pass in a DTD object
-
-
-=item B<documentElement>
-
- $root = $dom->documentElement();
-
-Returns the root element of the Document. A document can have just one root
-element to contain the documents data.
-
-Optionally one can use I<<<<<< getDocumentElement >>>>>>.
-
-
-=item B<setDocumentElement>
-
- $dom->setDocumentElement( $root );
-
-This function enables you to set the root element for a document. The function
-supports the import of a node from a different document tree.
-
-
-=item B<createElement>
-
- $element = $dom->createElement( $nodename );
-
-This function creates a new Element Node bound to the DOM with the name C<<<<<< $nodename >>>>>>.
-
-
-=item B<createElementNS>
-
- $element = $dom->createElementNS( $namespaceURI, $qname );
-
-This function creates a new Element Node bound to the DOM with the name C<<<<<< $nodename >>>>>> and placed in the given namespace.
-
-
-=item B<createTextNode>
-
- $text = $dom->createTextNode( $content_text );
-
-As an equivalent of I<<<<<< createElement >>>>>>, but it creates a I<<<<<< Text Node >>>>>> bound to the DOM.
-
-
-=item B<createComment>
-
- $comment = $dom->createComment( $comment_text );
-
-As an equivalent of I<<<<<< createElement >>>>>>, but it creates a I<<<<<< Comment Node >>>>>> bound to the DOM.
-
-
-=item B<createAttribute>
-
- $attrnode = $doc->createAttribute($name [,$value]);
-
-Creates a new Attribute node.
-
-
-=item B<createAttributeNS>
-
- $attrnode = $doc->createAttributeNS( namespaceURI, $name [,$value] );
-
-Creates an Attribute bound to a namespace.
-
-
-=item B<createDocumentFragment>
-
- $fragment = $doc->createDocumentFragment();
-
-This function creates a DocumentFragment.
-
-
-=item B<createCDATASection>
-
- $cdata = $dom->create( $cdata_content );
-
-Similar to createTextNode and createComment, this function creates a
-CDataSection bound to the current DOM.
-
-
-=item B<createProcessingInstruction>
-
- my $pi = $doc->createProcessingInstruction( $target, $data );
-
-create a processing instruction node.
-
-Since this method is quite long one may use its short form I<<<<<< createPI() >>>>>>.
-
-
-=item B<createEntityReference>
-
- my $entref = $doc->createEntityReference($refname);
-
-If a document has a DTD specified, one can create entity references by using
-this function. If one wants to add a entity reference to the document, this
-reference has to be created by this function.
-
-An entity reference is unique to a document and cannot be passed to other
-documents as other nodes can be passed.
-
-I<<<<<< NOTE: >>>>>> A text content containing something that looks like an entity reference, will
-not be expanded to a real entity reference unless it is a predefined entity
-
-
-
- my $string = "&foo;";
- $some_element->appendText( $string );
- print $some_element->textContent; # prints "&amp;foo;"
-
-
-=item B<createInternalSubset>
-
- $dtd = $document->createInternalSubset( $rootnode, $public, $system);
-
-This function creates and adds an internal subset to the given document.
-Because the function automatically adds the DTD to the document there is no
-need to add the created node explicitly to the document.
-
-
-
- my $document = XML::LibXML::Document->new();
- my $dtd = $document->createInternalSubset( "foo", undef, "foo.dtd" );
-
-will result in the following XML document:
-
-
-
- <?xml version="1.0"?>
- <!DOCTYPE foo SYSTEM "foo.dtd">
-
-By setting the public parameter it is possible to set PUBLIC DTDs to a given
-document. So
-
-
-
- my $document = XML::LibXML::Document->new();
- my $dtd = $document->createInternalSubset( "foo", "-//FOO//DTD FOO 0.1//EN", undef );
-
-will cause the following declaration to be created on the document:
-
-
-
- <?xml version="1.0"?>
- <!DOCTYPE foo PUBLIC "-//FOO//DTD FOO 0.1//EN">
-
-
-=item B<createExternalSubset>
-
- $dtd = $document->createExternalSubset( $rootnode_name, $publicId, $systemId);
-
-This function is similar to C<<<<<< createInternalSubset() >>>>>> but this DTD is considered to be external and is therefore not added to the
-document itself. Nevertheless it can be used for validation purposes.
-
-
-=item B<importNode>
-
- $document->importNode( $node );
-
-If a node is not part of a document, it can be imported to another document. As
-specified in DOM Level 2 Specification the Node will not be altered or removed
-from its original document (C<<<<<< $node->cloneNode(1) >>>>>> will get called implicitly).
-
-I<<<<<< NOTE: >>>>>> Don't try to use importNode() to import sub-trees that contain an entity
-reference - even if the entity reference is the root node of the sub-tree. This
-will cause serious problems to your program. This is a limitation of libxml2
-and not of XML::LibXML itself.
-
-
-=item B<adoptNode>
-
- $document->adoptNode( $node );
-
-If a node is not part of a document, it can be imported to another document. As
-specified in DOM Level 3 Specification the Node will not be altered but it will
-removed from its original document.
-
-After a document adopted a node, the node, its attributes and all its
-descendants belong to the new document. Because the node does not belong to the
-old document, it will be unlinked from its old location first.
-
-I<<<<<< NOTE: >>>>>> Don't try to adoptNode() to import sub-trees that contain entity references -
-even if the entity reference is the root node of the sub-tree. This will cause
-serious problems to your program. This is a limitation of libxml2 and not of
-XML::LibXML itself.
-
-
-=item B<externalSubset>
-
- my $dtd = $doc->externalSubset;
-
-If a document has an external subset defined it will be returned by this
-function.
-
-I<<<<<< NOTE >>>>>> Dtd nodes are no ordinary nodes in libxml2. The support for these nodes in
-XML::LibXML is still limited. In particular one may not want use common node
-function on doctype declaration nodes!
-
-
-=item B<internalSubset>
-
- my $dtd = $doc->internalSubset;
-
-If a document has an internal subset defined it will be returned by this
-function.
-
-I<<<<<< NOTE >>>>>> Dtd nodes are no ordinary nodes in libxml2. The support for these nodes in
-XML::LibXML is still limited. In particular one may not want use common node
-function on doctype declaration nodes!
-
-
-=item B<setExternalSubset>
-
- $doc->setExternalSubset($dtd);
-
-I<<<<<< EXPERIMENTAL! >>>>>>
-
-This method sets a DTD node as an external subset of the given document.
-
-
-=item B<setInternalSubset>
-
- $doc->setInternalSubset($dtd);
-
-I<<<<<< EXPERIMENTAL! >>>>>>
-
-This method sets a DTD node as an internal subset of the given document.
-
-
-=item B<removeExternalSubset>
-
- my $dtd = $doc->removeExternalSubset();
-
-I<<<<<< EXPERIMENTAL! >>>>>>
-
-If a document has an external subset defined it can be removed from the
-document by using this function. The removed dtd node will be returned.
-
-
-=item B<removeInternalSubset>
-
- my $dtd = $doc->removeInternalSubset();
-
-I<<<<<< EXPERIMENTAL! >>>>>>
-
-If a document has an internal subset defined it can be removed from the
-document by using this function. The removed dtd node will be returned.
-
-
-=item B<getElementsByTagName>
-
- my @nodelist = $doc->getElementsByTagName($tagname);
-
-Implements the DOM Level 2 function
-
-In SCALAR context this function returns a L<<<<<< XML::LibXML::NodeList|XML::LibXML::NodeList >>>>>> object.
-
-
-=item B<getElementsByTagNameNS>
-
- my @nodelist = $doc->getElementsByTagNameNS($nsURI,$tagname);
-
-Implements the DOM Level 2 function
-
-In SCALAR context this function returns a L<<<<<< XML::LibXML::NodeList|XML::LibXML::NodeList >>>>>> object.
-
-
-=item B<getElementsByLocalName>
-
- my @nodelist = $doc->getElementsByLocalName($localname);
-
-This allows the fetching of all nodes from a given document with the given
-Localname.
-
-In SCALAR context this function returns a L<<<<<< XML::LibXML::NodeList|XML::LibXML::NodeList >>>>>> object.
-
-
-=item B<getElementById>
-
- my $node = $doc->getElementById($id);
-
-Returns the element that has an ID attribute with the given value. If no such
-element exists, this returns undef.
-
-Note: the ID of an element may change while manipulating the document. For
-documents with a DTD, the information about ID attributes is only available if
-DTD loading/validation has been requested. For HTML documents parsed with the
-HTML parser ID detection is done automatically. In XML documents, all "xml:id"
-attributes are considered to be of type ID. You can test ID-ness of an
-attribute node with $attr->isId().
-
-In versions 1.59 and earlier this method was called getElementsById() (plural)
-by mistake. Starting from 1.60 this name is maintained as an alias only for
-backward compatibility.
-
-
-=item B<indexElements>
-
- $dom->indexElements();
-
-This function causes libxml2 to stamp all elements in a document with their
-document position index which considerably speeds up XPath queries for large
-documents. It should only be used with static documents that won't be further
-changed by any DOM methods, because once a document is indexed, XPath will
-always prefer the index to other methods of determining the document order of
-nodes. XPath could therefore return improperly ordered node-lists when applied
-on a document that has been changed after being indexed. It is of course
-possible to use this method to re-index a modified document before using it
-with XPath again. This function is not a part of the DOM specification.
-
-This function returns number of elements indexed, -1 if error occurred, or -2
-if this feature is not available in the running libxml2.
-
-
-
-=back
-
-=head1 AUTHORS
-
-Matt Sergeant,
-Christian Glahn,
-Petr Pajas
-
-
-=head1 VERSION
-
-1.66
-
-=head1 COPYRIGHT
-
-2001-2007, AxKit.com Ltd; 2002-2006 Christian Glahn; 2006-2008 Petr Pajas, All rights reserved.
-
-=cut
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/DocumentFragment.pod b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/DocumentFragment.pod
deleted file mode 100644
index f7498005857..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/DocumentFragment.pod
+++ /dev/null
@@ -1,36 +0,0 @@
-=head1 NAME
-
-XML::LibXML::DocumentFragment - XML::LibXML's DOM L2 Document Fragment Implementation
-
-=head1 SYNOPSIS
-
-
-
- use XML::LibXML;
-
-
-=head1 DESCRIPTION
-
-This class is a helper class as described in the DOM Level 2 Specification. It
-is implemented as a node without name. All adding, inserting or replacing
-functions are aware of document fragments now.
-
-As well I<<<<<< all >>>>>> unbound nodes (all nodes that do not belong to any document sub-tree) are
-implicit members of document fragments.
-
-=head1 AUTHORS
-
-Matt Sergeant,
-Christian Glahn,
-Petr Pajas
-
-
-=head1 VERSION
-
-1.66
-
-=head1 COPYRIGHT
-
-2001-2007, AxKit.com Ltd; 2002-2006 Christian Glahn; 2006-2008 Petr Pajas, All rights reserved.
-
-=cut
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/Dtd.pod b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/Dtd.pod
deleted file mode 100644
index dc908030765..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/Dtd.pod
+++ /dev/null
@@ -1,98 +0,0 @@
-=head1 NAME
-
-XML::LibXML::Dtd - XML::LibXML DTD Handling
-
-=head1 SYNOPSIS
-
-
-
- use XML::LibXML;
-
- $dtd = XML::LibXML::Dtd->new($public_id, $system_id);
- $dtd = XML::LibXML::Dtd->parse_string($dtd_str);
- $publicId = $dtd->getName();
- $publicId = $dtd->publicId();
- $systemId = $dtd->systemId();
-
-=head1 DESCRIPTION
-
-This class holds a DTD. You may parse a DTD from either a string, or from an
-external SYSTEM identifier.
-
-No support is available as yet for parsing from a filehandle.
-
-XML::LibXML::Dtd is a sub-class of L<<<<<< Abstract Base Class of XML::LibXML Nodes|Abstract Base Class of XML::LibXML Nodes >>>>>>, so all the methods available to nodes (particularly toString()) are available
-to Dtd objects.
-
-
-=head1 METHODS
-
-=over 4
-
-=item B<new>
-
- $dtd = XML::LibXML::Dtd->new($public_id, $system_id);
-
-Parse a DTD from the system identifier, and return a DTD object that you can
-pass to $doc->is_valid() or $doc->validate().
-
-
-
- my $dtd = XML::LibXML::Dtd->new(
- "SOME // Public / ID / 1.0",
- "test.dtd"
- );
- my $doc = XML::LibXML->new->parse_file("test.xml");
- $doc->validate($dtd);
-
-
-=item B<parse_string>
-
- $dtd = XML::LibXML::Dtd->parse_string($dtd_str);
-
-The same as new() above, except you can parse a DTD from a string. Note that
-parsing from string may fail if the DTD contains external parametric-entity
-references with relative URLs.
-
-
-=item B<getName>
-
- $publicId = $dtd->getName();
-
-Returns the name of DTD; i.e., the name immediately following the DOCTYPE
-keyword.
-
-
-=item B<publicId>
-
- $publicId = $dtd->publicId();
-
-Returns the public identifier of the external subset.
-
-
-=item B<systemId>
-
- $systemId = $dtd->systemId();
-
-Returns the system identifier of the external subset.
-
-
-
-=back
-
-=head1 AUTHORS
-
-Matt Sergeant,
-Christian Glahn,
-Petr Pajas
-
-
-=head1 VERSION
-
-1.66
-
-=head1 COPYRIGHT
-
-2001-2007, AxKit.com Ltd; 2002-2006 Christian Glahn; 2006-2008 Petr Pajas, All rights reserved.
-
-=cut
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/Element.pod b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/Element.pod
deleted file mode 100644
index 40e06e97648..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/Element.pod
+++ /dev/null
@@ -1,380 +0,0 @@
-=head1 NAME
-
-XML::LibXML::Element - XML::LibXML Class for Element Nodes
-
-=head1 SYNOPSIS
-
-
-
- use XML::LibXML;
- # Only methods specific to Element nodes are listed here,
- # see XML::LibXML::Node manpage for other methods
-
- $node = XML::LibXML::Element->new( $name );
- $node->setAttribute( $aname, $avalue );
- $node->setAttributeNS( $nsURI, $aname, $avalue );
- $avalue = $node->getAttribute( $aname );
- $avalue = $node->setAttributeNS( $nsURI, $aname );
- $attrnode = $node->getAttributeNode( $aname );
- $attrnode = $node->getAttributeNodeNS( $namespaceURI, $aname );
- $node->removeAttribute( $aname );
- $node->removeAttributeNS( $nsURI, $aname );
- $boolean = $node->hasAttribute( $aname );
- $boolean = $node->hasAttributeNS( $nsURI, $aname );
- @nodes = $node->getChildrenByTagName($tagname);
- @nodes = $node->getChildrenByTagNameNS($nsURI,$tagname);
- @nodes = $node->getChildrenByLocalName($localname);
- @nodes = $node->getElementsByTagName($tagname);
- @nodes = $node->getElementsByTagNameNS($nsURI,$localname);
- @nodes = $node->getElementsByLocalName($localname);
- $node->appendWellBalancedChunk( $chunk );
- $node->appendText( $PCDATA );
- $node->appendTextNode( $PCDATA );
- $node->appendTextChild( $childname , $PCDATA );
- $node->setNamespace( $nsURI , $nsPrefix, $activate );
- $node->setNamespaceDeclURI( $nsPrefix, $newURI );
- $node->setNamespaceDeclPrefix( $oldPrefix, $newPrefix );
-
-=head1 METHODS
-
-The class inherits from L<<<<<< Abstract Base Class of XML::LibXML Nodes|Abstract Base Class of XML::LibXML Nodes >>>>>>. The documentation for Inherited methods is not listed here.
-
-Many functions listed here are extensively documented in the L<<<<<< DOM Level 3 specification|http://www.w3.org/TR/DOM-Level-3-Core/ >>>>>>. Please refer to the specification for extensive documentation.
-
-=over 4
-
-=item B<new>
-
- $node = XML::LibXML::Element->new( $name );
-
-This function creates a new node unbound to any DOM.
-
-
-=item B<setAttribute>
-
- $node->setAttribute( $aname, $avalue );
-
-This method sets or replaces the node's attribute C<<<<<< $aname >>>>>> to the value C<<<<<< $avalue >>>>>>
-
-
-=item B<setAttributeNS>
-
- $node->setAttributeNS( $nsURI, $aname, $avalue );
-
-Namespace-aware version of C<<<<<< setAttribute >>>>>>, where C<<<<<< $nsURI >>>>>> is a namespace URI, C<<<<<< $aname >>>>>> is a qualified name, and C<<<<<< $avalue >>>>>> is the value. The namespace URI may be null (empty or undefined) in order to
-create an attribute which has no namespace.
-
-The current implementation differs from DOM in the following aspects
-
-If an attribute with the same local name and namespace URI already exists on
-the element, but its prefix differs from the prefix of C<<<<<< $aname >>>>>>, then this function is supposed to change the prefix (regardless of namespace
-declarations and possible collisions). However, the current implementation does
-rather the opposite. If a prefix is declared for the namespace URI in the scope
-of the attribute, then the already declared prefix is used, disregarding the
-prefix specified in C<<<<<< $aname >>>>>>. If no prefix is declared for the namespace, the function tries to declare the
-prefix specified in C<<<<<< $aname >>>>>> and dies if the prefix is already taken by some other namespace.
-
-According to DOM Level 2 specification, this method can also be used to create
-or modify special attributes used for declaring XML namespaces (which belong to
-the namespace "http://www.w3.org/2000/xmlns/" and have prefix or name "xmlns").
-This should work since version 1.61, but again the implementation differs from
-DOM specification in the following: if a declaration of the same namespace
-prefix already exists on the element, then changing its value via this method
-automatically changes the namespace of all elements and attributes in its
-scope. This is because in libxml2 the namespace URI of an element is not static
-but is computed from a pointer to a namespace declaration attribute.
-
-
-=item B<getAttribute>
-
- $avalue = $node->getAttribute( $aname );
-
-If C<<<<<< $node >>>>>> has an attribute with the name C<<<<<< $aname >>>>>>, the value of this attribute will get returned.
-
-
-=item B<getAttributeNS>
-
- $avalue = $node->setAttributeNS( $nsURI, $aname );
-
-Retrieves an attribute value by local name and namespace URI.
-
-
-=item B<getAttributeNode>
-
- $attrnode = $node->getAttributeNode( $aname );
-
-Retrieve an attribute node by name. If no attribute with a given name exists, C<<<<<< undef >>>>>> is returned.
-
-
-=item B<getAttributeNodeNS>
-
- $attrnode = $node->getAttributeNodeNS( $namespaceURI, $aname );
-
-Retrieves an attribute node by local name and namespace URI. If no attribute
-with a given localname and namespace exists, C<<<<<< undef >>>>>> is returned.
-
-
-=item B<removeAttribute>
-
- $node->removeAttribute( $aname );
-
-The method removes the attribute C<<<<<< $aname >>>>>> from the node's attribute list, if the attribute can be found.
-
-
-=item B<removeAttributeNS>
-
- $node->removeAttributeNS( $nsURI, $aname );
-
-Namespace version of C<<<<<< removeAttribute >>>>>>
-
-
-=item B<hasAttribute>
-
- $boolean = $node->hasAttribute( $aname );
-
-This function tests if the named attribute is set for the node. If the
-attribute is specified, TRUE (1) will be returned, otherwise the return value
-is FALSE (0).
-
-
-=item B<hasAttributeNS>
-
- $boolean = $node->hasAttributeNS( $nsURI, $aname );
-
-namespace version of C<<<<<< hasAttribute >>>>>>
-
-
-=item B<getChildrenByTagName>
-
- @nodes = $node->getChildrenByTagName($tagname);
-
-The function gives direct access to all child elements of the current node with
-a given tagname, where tagname is a qualified name, that is, in case of
-namespace usage it may consist of a prefix and local name. This function makes
-things a lot easier if one needs to handle big data sets. A special tagname '*'
-can be used to match any name.
-
-If this function is called in SCALAR context, it returns the number of elements
-found.
-
-
-=item B<getChildrenByTagNameNS>
-
- @nodes = $node->getChildrenByTagNameNS($nsURI,$tagname);
-
-Namespace version of C<<<<<< getChildrenByTagName >>>>>>. A special nsURI '*' matches any namespace URI, in which case the function
-behaves just like C<<<<<< getChildrenByLocalName >>>>>>.
-
-If this function is called in SCALAR context, it returns the number of elements
-found.
-
-
-=item B<getChildrenByLocalName>
-
- @nodes = $node->getChildrenByLocalName($localname);
-
-The function gives direct access to all child elements of the current node with
-a given local name. It makes things a lot easier if one needs to handle big
-data sets. A special C<<<<<< localname >>>>>> '*' can be used to match any local name.
-
-If this function is called in SCALAR context, it returns the number of elements
-found.
-
-
-=item B<getElementsByTagName>
-
- @nodes = $node->getElementsByTagName($tagname);
-
-This function is part of the spec. It fetches all descendants of a node with a
-given tagname, where C<<<<<< tagname >>>>>> is a qualified name, that is, in case of namespace usage it may consist of a
-prefix and local name. A special C<<<<<< tagname >>>>>> '*' can be used to match any tag name.
-
-In SCALAR context this function returns a L<<<<<< XML::LibXML::NodeList|XML::LibXML::NodeList >>>>>> object.
-
-
-=item B<getElementsByTagNameNS>
-
- @nodes = $node->getElementsByTagNameNS($nsURI,$localname);
-
-Namespace version of C<<<<<< getElementsByTagName >>>>>> as found in the DOM spec. A special C<<<<<< localname >>>>>> '*' can be used to match any local name and C<<<<<< nsURI >>>>>> '*' can be used to match any namespace URI.
-
-In SCALAR context this function returns a L<<<<<< XML::LibXML::NodeList|XML::LibXML::NodeList >>>>>> object.
-
-
-=item B<getElementsByLocalName>
-
- @nodes = $node->getElementsByLocalName($localname);
-
-This function is not found in the DOM specification. It is a mix of
-getElementsByTagName and getElementsByTagNameNS. It will fetch all tags
-matching the given local-name. This allows one to select tags with the same
-local name across namespace borders.
-
-In SCALAR context this function returns a L<<<<<< XML::LibXML::NodeList|XML::LibXML::NodeList >>>>>> object.
-
-
-=item B<appendWellBalancedChunk>
-
- $node->appendWellBalancedChunk( $chunk );
-
-Sometimes it is necessary to append a string coded XML Tree to a node. I<<<<<< appendWellBalancedChunk >>>>>> will do the trick for you. But this is only done if the String is C<<<<<< well-balanced >>>>>>.
-
-I<<<<<< Note that appendWellBalancedChunk() is only left for compatibility reasons >>>>>>. Implicitly it uses
-
-
-
- my $fragment = $parser->parse_xml_chunk( $chunk );
- $node->appendChild( $fragment );
-
-This form is more explicit and makes it easier to control the flow of a script.
-
-
-=item B<appendText>
-
- $node->appendText( $PCDATA );
-
-alias for appendTextNode().
-
-
-=item B<appendTextNode>
-
- $node->appendTextNode( $PCDATA );
-
-This wrapper function lets you add a string directly to an element node.
-
-
-=item B<appendTextChild>
-
- $node->appendTextChild( $childname , $PCDATA );
-
-Somewhat similar with C<<<<<< appendTextNode >>>>>>: It lets you set an Element, that contains only a C<<<<<< text node >>>>>> directly by specifying the name and the text content.
-
-
-=item B<setNamespace>
-
- $node->setNamespace( $nsURI , $nsPrefix, $activate );
-
-setNamespace() allows one to apply a namespace to an element. The function
-takes three parameters: 1. the namespace URI, which is required and the two
-optional values prefix, which is the namespace prefix, as it should be used in
-child elements or attributes as well as the additional activate parameter. If
-prefix is not given, undefined or empty, this function tries to create a
-declaration of the default namespace.
-
-The activate parameter is most useful: If this parameter is set to FALSE (0), a
-new namespace declaration is simply added to the element while the element's
-namespace itself is not altered. Nevertheless, activate is set to TRUE (1) on
-default. In this case the namespace is used as the node's effective namespace.
-This means the namespace prefix is added to the node name and if there was a
-namespace already active for the node, it will be replaced (but its declaration
-is not removed from the document). A new namespace declaration is only created
-if necessary (that is, if the element is already in the scope of a namespace
-declaration associating the prefix with the namespace URI, then this
-declaration is reused).
-
-The following example may clarify this:
-
-
-
- my $e1 = $doc->createElement("bar");
- $e1->setNamespace("http://foobar.org", "foo")
-
-results
-
-
-
- <foo:bar xmlns:foo="http://foobar.org"/>
-
-while
-
-
-
- my $e2 = $doc->createElement("bar");
- $e2->setNamespace("http://foobar.org", "foo",0)
-
-results only
-
-
-
- <bar xmlns:foo="http://foobar.org"/>
-
-By using $activate == 0 it is possible to create multiple namespace
-declarations on a single element.
-
-The function fails if it is required to create a declaration associating the
-prefix with the namespace URI but the element already carries a declaration
-with the same prefix but different namespace URI.
-
-
-=item B<setNamespaceDeclURI>
-
- $node->setNamespaceDeclURI( $nsPrefix, $newURI );
-
-EXPERIMENTAL IN 1.61 !
-
-This function manipulates directly with an existing namespace declaration on an
-element. It takes two parameters: the prefix by which it looks up the namespace
-declaration and a new namespace URI which replaces its previous value.
-
-It returns 1 if the namespace declaration was found and changed, 0 otherwise.
-
-All elements and attributes (even those previously unbound from the document)
-for which the namespace declaration determines their namespace belong to the
-new namespace after the change.
-
-If the new URI is undef or empty, the nodes have no namespace and no prefix
-after the change. Namespace declarations once nulled in this way do not further
-appear in the serialized output (but do remain in the document for internal
-integrity of libxml2 data structures).
-
-This function is NOT part of any DOM API.
-
-
-=item B<setNamespaceDeclPrefix>
-
- $node->setNamespaceDeclPrefix( $oldPrefix, $newPrefix );
-
-EXPERIMENTAL IN 1.61 !
-
-This function manipulates directly with an existing namespace declaration on an
-element. It takes two parameters: the old prefix by which it looks up the
-namespace declaration and a new prefix which is to replace the old one.
-
-The function dies with an error if the element is in the scope of another
-declaration whose prefix equals to the new prefix, or if the change should
-result in a declaration with a non-empty prefix but empty namespace URI.
-Otherwise, it returns 1 if the namespace declaration was found and changed and
-0 if not found.
-
-All elements and attributes (even those previously unbound from the document)
-for which the namespace declaration determines their namespace change their
-prefix to the new value.
-
-If the new prefix is undef or empty, the namespace declaration becomes a
-declaration of a default namespace. The corresponding nodes drop their
-namespace prefix (but remain in the, now default, namespace). In this case the
-function fails, if the containing element is in the scope of another default
-namespace declaration.
-
-This function is NOT part of any DOM API.
-
-
-
-=back
-
-=head1 AUTHORS
-
-Matt Sergeant,
-Christian Glahn,
-Petr Pajas
-
-
-=head1 VERSION
-
-1.66
-
-=head1 COPYRIGHT
-
-2001-2007, AxKit.com Ltd; 2002-2006 Christian Glahn; 2006-2008 Petr Pajas, All rights reserved.
-
-=cut
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/InputCallback.pod b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/InputCallback.pod
deleted file mode 100644
index 113b8f53d28..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/InputCallback.pod
+++ /dev/null
@@ -1,288 +0,0 @@
-=head1 NAME
-
-XML::LibXML::InputCallback - XML::LibXML Class for Input Callbacks
-
-=head1 SYNOPSIS
-
-
-
- use XML::LibXML;
-
-
-=head1 DESCRIPTION
-
-You may get unexpected results if you are trying to load external documents
-during libxml2 parsing if the location of the resource is not a HTTP, FTP or
-relative location but a absolute path for example. To get around this
-limitation, you may add your own input handler to open, read and close
-particular types of locations or URI classes. Using this input callback
-handlers, you can handle your own custom URI schemes for example.
-
-The input callbacks are used whenever LibXML has to get something other than
-externally parsed entities from somewhere. They are implemented using a
-callback stack on the Perl layer in analogy to libxml2's native callback stack.
-
-The XML::LibXML::InputCallback class transparently registers the input
-callbacks for the libxml2's parser processes.
-
-
-=head2 How does XML::LibXML::InputCallback work?
-
-The libxml2 library offers a callback implementation as global functions only.
-To work-around the troubles resulting in having only global callbacks - for
-example, if the same global callback stack is manipulated by different
-applications running together in a single Apache Web-server environment -,
-XML::LibXML::InputCallback comes with a object-oriented and a function-oriented
-part.
-
-Using the function-oriented part the global callback stack of libxml2 can be
-manipulated. Those functions can be used as interface to the callbacks on the
-C- and XS Layer. At the object-oriented part, operations for working with the
-"pseudo-localized" callback stack are implemented. Currently, you can register
-and de-register callbacks on the Perl layer and initialize them on a per parser
-basis.
-
-
-=head3 Callback Groups
-
-The libxml2 input callbacks come in groups. One group contains a URI matcher (I<<<<<< match >>>>>>), a data stream constructor (I<<<<<< open >>>>>>), a data stream reader (I<<<<<< read >>>>>>), and a data stream destructor (I<<<<<< close >>>>>>). The callbacks can be manipulated on a per group basis only.
-
-
-=head3 The Parser Process
-
-The parser process work on a XML data stream, along which, links to other
-resources can be embedded. This can be links to external DTDs or XIncludes for
-example. Those resources are identified by URIs. The callback implementation of
-libxml2 assumes that one callback group can handle a certain amount of URIs and
-a certain URI scheme. Per default, callback handlers for I<<<<<< file://* >>>>>>, I<<<<<< file:://*.gz >>>>>>, I<<<<<< http://* >>>>>> and I<<<<<< ftp://* >>>>>> are registered.
-
-Callback groups in the callback stack are processed from top to bottom, meaning
-that callback groups registered later will be processed before the earlier
-registered ones.
-
-While parsing the data stream, the libxml2 parser checks if a registered
-callback group will handle a URI - if they will not, the URI will be
-interpreted as I<<<<<< file://URI >>>>>>. To handle a URI, the I<<<<<< match >>>>>> callback will have to return '1'. If that happens, the handling of the URI will
-be passed to that callback group. Next, the URI will be passed to the I<<<<<< open >>>>>> callback, which should return a I<<<<<< reference >>>>>> to the data stream if it successfully opened the file, '0' otherwise. If
-opening the stream was successful, the I<<<<<< read >>>>>> callback will be called repeatedly until it returns an empty string. After the
-read callback, the I<<<<<< close >>>>>> callback will be called to close the stream.
-
-
-=head3 Organisation of callback groups in XML::LibXML::InputCallback
-
-Callback groups are implemented as a stack (Array), each entry holds a
-reference to an array of the callbacks. For the libxml2 library, the
-XML::LibXML::InputCallback callback implementation appears as one single
-callback group. The Perl implementation however allows to manage different
-callback stacks on a per libxml2-parser basis.
-
-
-=head2 Using XML::LibXML::InputCallback
-
-After object instantiation using the parameter-less constructor, you can
-register callback groups.
-
-
-
- my $input_callbacks = XML::LibXML::InputCallback->new();
- $input_callbacks->register_callbacks([ $match_cb1, $open_cb1,
- $read_cb1, $close_cb1 ] );
- $input_callbacks->register_callbacks([ $match_cb2, $open_cb2,
- $read_cb2, $close_cb2 ] );
- $input_callbacks->register_callbacks( [ $match_cb3, $open_cb3,
- $read_cb3, $close_cb3 ] );
-
- $parser->input_callbacks( $input_callbacks );
- $parser->parse_file( $some_xml_file );
-
-
-=head2 What about the old callback system prior to XML::LibXML::InputCallback?
-
-In XML::LibXML versions prior to 1.59 - i.e. without the
-XML::LibXML::InputCallback module - you could define your callbacks either
-using globally or locally. You still can do that using
-XML::LibXML::InputCallback, and in addition to that you can define the
-callbacks on a per parser basis!
-
-If you use the old callback interface through global callbacks,
-XML::LibXML::InputCallback will treat them with a lower priority as the ones
-registered using the new interface. The global callbacks will not override the
-callback groups registered using the new interface. Local callbacks are
-attached to a specific parser instance, therefore they are treated with highest
-priority. If the I<<<<<< match >>>>>> callback of the callback group registered as local variable is identical to one
-of the callback groups registered using the new interface, that callback group
-will be replaced.
-
-Users of the old callback implementation whose I<<<<<< open >>>>>> callback returned a plain string, will have to adapt their code to return a
-reference to that string after upgrading to version >= 1.59. The new callback
-system can only deal with the I<<<<<< open >>>>>> callback returning a reference!
-
-
-=head1 INTERFACE DESCRIPTION
-
-
-=head2 Global Variables
-
-=over 4
-
-=item B<$_CUR_CB>
-
-Stores the current callback and can be used as shortcut to access the callback
-stack.
-
-
-=item B<@_GLOBAL_CALLBACKS>
-
-Stores all callback groups for the current parser process.
-
-
-=item B<@_CB_STACK>
-
-Stores the currently used callback group. Used to prevent parser errors when
-dealing with nested XML data.
-
-
-
-=back
-
-
-=head2 Global Callbacks
-
-=over 4
-
-=item B<_callback_match>
-
-Implements the interface for the I<<<<<< match >>>>>> callback at C-level and for the selection of the callback group from the
-callbacks defined at the Perl-level.
-
-
-=item B<_callback_open>
-
-Forwards the I<<<<<< open >>>>>> callback from libxml2 to the corresponding callback function at the Perl-level.
-
-
-=item B<_callback_read>
-
-Forwards the read request to the corresponding callback function at the
-Perl-level and returns the result to libxml2.
-
-
-=item B<_callback_close>
-
-Forwards the I<<<<<< close >>>>>> callback from libxml2 to the corresponding callback function at the
-Perl-level..
-
-
-
-=back
-
-
-=head2 Class methods
-
-=over 4
-
-=item B<new()>
-
-A simple constructor.
-
-
-=item B<register_callbacks( [ $match_cb, $open_cb, $read_cb, $close_cb ])>
-
-The four callbacks I<<<<<< have >>>>>> to be given as array reference in the above order I<<<<<< match >>>>>>, I<<<<<< open >>>>>>, I<<<<<< read >>>>>>, I<<<<<< close >>>>>>!
-
-
-=item B<unregister_callbacks( [ $match_cb, $open_cb, $read_cb, $close_cb ])>
-
-With no arguments given, C<<<<<< unregister_callbacks() >>>>>> will delete the last registered callback group from the stack. If four
-callbacks are passed as array reference, the callback group to unregister will
-be identified by the I<<<<<< match >>>>>> callback and deleted from the callback stack. Note that if several identical I<<<<<< match >>>>>> callbacks are defined in different callback groups, ALL of them will be deleted
-from the stack.
-
-
-=item B<init_callbacks()>
-
-Initializes the callback system before a parsing process.
-
-
-=item B<cleanup_callbacks()>
-
-Resets global variables and the libxml2 callback stack.
-
-
-=item B<lib_init_callbacks()>
-
-Used internally for callback registration at C-level.
-
-
-=item B<lib_cleanup_callbacks()>
-
-Used internally for callback resetting at the C-level.
-
-
-
-=back
-
-
-
-
-=head1 EXAMPLE CALLBACKS
-
-The following example is a purely fictitious example that uses a
-MyScheme::Handler object that responds to methods similar to an IO::Handle.
-
-
-
- # Define the four callback functions
- sub match_uri {
- my $uri = shift;
- return $uri =~ /^myscheme:/; # trigger our callback group at a 'myscheme' URIs
- }
-
- sub open_uri {
- my $uri = shift;
- my $handler = MyScheme::Handler->new($uri);
- return $handler;
- }
-
- # The returned $buffer will be parsed by the libxml2 parser
- sub read_uri {
- my $handler = shift;
- my $length = shift;
- my $buffer;
- read($handler, $buffer, $length);
- return $buffer; # $buffer will be an empty string '' if read() is done
- }
-
- # Close the handle associated with the resource.
- sub close_uri {
- my $handler = shift;
- close($handler);
- }
-
- # Register them with a instance of XML::LibXML::InputCallback
- my $input_callbacks = XML::LibXML::InputCallback->new();
- $input_callbacks->register_callbacks([ \&match_uri, \&open_uri,
- \&read_uri, \&close_uri ] );
-
- # Register the callback group at a parser instance
- $parser->input_callbacks( $input_callbacks );
-
- # $some_xml_file will be parsed using our callbacks
- $parser->parse_file( $some_xml_file );
-
-=head1 AUTHORS
-
-Matt Sergeant,
-Christian Glahn,
-Petr Pajas
-
-
-=head1 VERSION
-
-1.66
-
-=head1 COPYRIGHT
-
-2001-2007, AxKit.com Ltd; 2002-2006 Christian Glahn; 2006-2008 Petr Pajas, All rights reserved.
-
-=cut
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/Literal.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/Literal.pm
deleted file mode 100644
index 21af2b7d86c..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/Literal.pm
+++ /dev/null
@@ -1,102 +0,0 @@
-# $Id: Literal.pm 709 2008-01-29 21:01:32Z pajas $
-
-package XML::LibXML::Literal;
-use XML::LibXML::Boolean;
-use XML::LibXML::Number;
-use strict;
-
-use vars qw ($VERSION);
-$VERSION = "1.66"; # VERSION TEMPLATE: DO NOT CHANGE
-
-use overload
- '""' => \&value,
- 'cmp' => \&cmp;
-
-sub new {
- my $class = shift;
- my ($string) = @_;
-
-# $string =~ s/&quot;/"/g;
-# $string =~ s/&apos;/'/g;
-
- bless \$string, $class;
-}
-
-sub as_string {
- my $self = shift;
- my $string = $$self;
- $string =~ s/'/&apos;/g;
- return "'$string'";
-}
-
-sub as_xml {
- my $self = shift;
- my $string = $$self;
- return "<Literal>$string</Literal>\n";
-}
-
-sub value {
- my $self = shift;
- $$self;
-}
-
-sub cmp {
- my $self = shift;
- my ($cmp, $swap) = @_;
- if ($swap) {
- return $cmp cmp $$self;
- }
- return $$self cmp $cmp;
-}
-
-sub evaluate {
- my $self = shift;
- $self;
-}
-
-sub to_boolean {
- my $self = shift;
- return (length($$self) > 0) ? XML::LibXML::Boolean->True : XML::LibXML::Boolean->False;
-}
-
-sub to_number { return XML::LibXML::Number->new($_[0]->value); }
-sub to_literal { return $_[0]; }
-
-sub string_value { return $_[0]->value; }
-
-1;
-__END__
-
-=head1 NAME
-
-XML::LibXML::Literal - Simple string values.
-
-=head1 DESCRIPTION
-
-In XPath terms a Literal is what we know as a string.
-
-=head1 API
-
-=head2 new($string)
-
-Create a new Literal object with the value in $string. Note that &quot; and
-&apos; will be converted to " and ' respectively. That is not part of the XPath
-specification, but I consider it useful. Note though that you have to go
-to extraordinary lengths in an XML template file (be it XSLT or whatever) to
-make use of this:
-
- <xsl:value-of select="&quot;I'm feeling &amp;quot;sad&amp;quot;&quot;"/>
-
-Which produces a Literal of:
-
- I'm feeling "sad"
-
-=head2 value()
-
-Also overloaded as stringification, simply returns the literal string value.
-
-=head2 cmp($literal)
-
-Returns the equivalent of perl's cmp operator against the given $literal.
-
-=cut
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/Namespace.pod b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/Namespace.pod
deleted file mode 100644
index 3fe6b5f07a6..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/Namespace.pod
+++ /dev/null
@@ -1,139 +0,0 @@
-=head1 NAME
-
-XML::LibXML::Namespace - XML::LibXML Namespace Implementation
-
-=head1 SYNOPSIS
-
-
-
- use XML::LibXML;
- # Only methods specific to Namespace nodes are listed here,
- # see XML::LibXML::Node manpage for other methods
-
- my $ns = XML::LibXML::Namespace->new($nsURI);
- print $ns->nodeName();
- print $ns->name();
- $localname = $ns->getLocalName();
- print $ns->getData();
- print $ns->getValue();
- print $ns->value();
- $known_uri = $ns->getNamespaceURI();
- $known_prefix = $ns->getPrefix();
-
-=head1 DESCRIPTION
-
-Namespace nodes are returned by both $element->findnodes('namespace::foo') or
-by $node->getNamespaces().
-
-The namespace node API is not part of any current DOM API, and so it is quite
-minimal. It should be noted that namespace nodes are I<<<<<< not >>>>>> a sub class of L<<<<<< Abstract Base Class of XML::LibXML Nodes|Abstract Base Class of XML::LibXML Nodes >>>>>>, however Namespace nodes act a lot like attribute nodes, and similarly named
-methods will return what you would expect if you treated the namespace node as
-an attribute. Note that in order to fix several inconsistencies between the API
-and the documentation, the behavior of some functions have been changed in
-1.64.
-
-
-=head1 METHODS
-
-=over 4
-
-=item B<new>
-
- my $ns = XML::LibXML::Namespace->new($nsURI);
-
-Creates a new Namespace node. Note that this is not a 'node' as an attribute or
-an element node. Therefore you can't do call all L<<<<<< Abstract Base Class of XML::LibXML Nodes|Abstract Base Class of XML::LibXML Nodes >>>>>> Functions. All functions available for this node are listed below.
-
-Optionally you can pass the prefix to the namespace constructor. If this second
-parameter is omitted you will create a so called default namespace. Note, the
-newly created namespace is not bound to any document or node, therefore you
-should not expect it to be available in an existing document.
-
-
-=item B<declaredURI>
-
-Returns the URI for this namespace.
-
-
-=item B<declaredPrefix>
-
-Returns the prefix for this namespace.
-
-
-=item B<nodeName>
-
- print $ns->nodeName();
-
-Returns "xmlns:prefix", where prefix is the prefix for this namespace.
-
-
-=item B<name>
-
- print $ns->name();
-
-Alias for nodeName()
-
-
-=item B<getLocalName>
-
- $localname = $ns->getLocalName();
-
-Returns the local name of this node as if it were an attribute, that is, the
-prefix associated with the namespace.
-
-
-=item B<getData>
-
- print $ns->getData();
-
-Returns the URI of the namespace, i.e. the value of this node as if it were an
-attribute.
-
-
-=item B<getValue>
-
- print $ns->getValue();
-
-Alias for getData()
-
-
-=item B<value>
-
- print $ns->value();
-
-Alias for getData()
-
-
-=item B<getNamespaceURI>
-
- $known_uri = $ns->getNamespaceURI();
-
-Returns the string "http://www.w3.org/2000/xmlns/"
-
-
-=item B<getPrefix>
-
- $known_prefix = $ns->getPrefix();
-
-Returns the string "xmlns"
-
-
-
-=back
-
-=head1 AUTHORS
-
-Matt Sergeant,
-Christian Glahn,
-Petr Pajas
-
-
-=head1 VERSION
-
-1.66
-
-=head1 COPYRIGHT
-
-2001-2007, AxKit.com Ltd; 2002-2006 Christian Glahn; 2006-2008 Petr Pajas, All rights reserved.
-
-=cut
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/Node.pod b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/Node.pod
deleted file mode 100644
index 6da553ec6b3..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/Node.pod
+++ /dev/null
@@ -1,661 +0,0 @@
-=head1 NAME
-
-XML::LibXML::Node - Abstract Base Class of XML::LibXML Nodes
-
-=head1 SYNOPSIS
-
-
-
- use XML::LibXML;
-
- $name = $node->nodeName;
- $node->setNodeName( $newName );
- $bool = $node->isSameNode( $other_node );
- $bool = $node->isEqual( $other_node );
- $content = $node->nodeValue;
- $content = $node->textContent;
- $type = $node->nodeType;
- $node->unbindNode();
- $childnode = $node->removeChild( $childnode );
- $oldnode = $node->replaceChild( $newNode, $oldNode );
- $node->replaceNode($newNode);
- $childnode = $node->appendChild( $childnode );
- $childnode = $node->addChild( $chilnode );
- $node = $parent->addNewChild( $nsURI, $name );
- $node->addSibling($newNode);
- $newnode =$node->cloneNode( $deep );
- $parentnode = $node->parentNode;
- $nextnode = $node->nextSibling();
- $prevnode = $node->previousSibling();
- $boolean = $node->hasChildNodes();
- $childnode = $node->firstChild;
- $childnode = $node->lastChild;
- $documentnode = $node->ownerDocument;
- $node = $node->getOwner;
- $node->setOwnerDocument( $doc );
- $node->insertBefore( $newNode, $refNode );
- $node->insertAfter( $newNode, $refNode );
- @nodes = $node->findnodes( $xpath_expression );
- $result = $node->find( $xpath );
- print $node->findvalue( $xpath );
- @childnodes = $node->childNodes;
- $xmlstring = $node->toString($format,$docencoding);
- $c14nstring = $node->toStringC14N($with_comments, $xpath_expression);
- $ec14nstring = $node->toStringEC14N($with_comments, $xpath_expression, $inclusive_prefix_list);
- $str = $doc->serialize($format);
- $c14nstr = $doc->serialize_c14n($comment_flag,$xpath);
- $ec14nstr = $doc->serialize_ec14n($comment_flag,$xpath,$inclusive_prefix_list);
- $localname = $node->localname;
- $nameprefix = $node->prefix;
- $uri = $node->namespaceURI();
- $boolean = $node->hasAttributes();
- @attributelist = $node->attributes();
- $URI = $node->lookupNamespaceURI( $prefix );
- $prefix = $node->lookupNamespacePrefix( $URI );
- $node->normalize;
- @nslist = $node->getNamespaces;
- $node->removeChildNodes();
- $node->nodePath();
- $lineno = $node->line_number();
-
-=head1 DESCRIPTION
-
-XML::LibXML::Node defines functions that are common to all Node Types. A
-LibXML::Node should never be created standalone, but as an instance of a high
-level class such as LibXML::Element or LibXML::Text. The class itself should
-provide only common functionality. In XML::LibXML each node is part either of a
-document or a document-fragment. Because of this there is no node without a
-parent. This may causes confusion with "unbound" nodes.
-
-
-=head1 METHODS
-
-Many functions listed here are extensively documented in the L<<<<<< DOM Level 3 specification|http://www.w3.org/TR/DOM-Level-3-Core/ >>>>>>. Please refer to the specification for extensive documentation.
-
-=over 4
-
-=item B<nodeName>
-
- $name = $node->nodeName;
-
-Returns the node's name. This function is aware of namespaces and returns the
-full name of the current node (C<<<<<< prefix:localname >>>>>>).
-
-Since 1.62 this function also returns the correct DOM names for node types with
-constant names, namely: #text, #cdata-section, #comment, #document,
-#document-fragment.
-
-
-=item B<setNodeName>
-
- $node->setNodeName( $newName );
-
-In very limited situations, it is useful to change a nodes name. In the DOM
-specification this should throw an error. This Function is aware of namespaces.
-
-
-=item B<isSameNode>
-
- $bool = $node->isSameNode( $other_node );
-
-returns TRUE (1) if the given nodes refer to the same node structure, otherwise
-FALSE (0) is returned.
-
-
-=item B<isEqual>
-
- $bool = $node->isEqual( $other_node );
-
-deprecated version of isSameNode().
-
-I<<<<<< NOTE >>>>>> isEqual will change behaviour to follow the DOM specification
-
-
-=item B<nodeValue>
-
- $content = $node->nodeValue;
-
-If the node has any content (such as stored in a C<<<<<< text node >>>>>>) it can get requested through this function.
-
-I<<<<<< NOTE: >>>>>> Element Nodes have no content per definition. To get the text value of an
-Element use textContent() instead!
-
-
-=item B<textContent>
-
- $content = $node->textContent;
-
-this function returns the content of all text nodes in the descendants of the
-given node as specified in DOM.
-
-
-=item B<nodeType>
-
- $type = $node->nodeType;
-
-Return a numeric value representing the node type of this node. The module
-XML::LibXML by default exports constants for the node types (see the EXPORT
-section in the L<<<<<< Perl Binding for libxml2|Perl Binding for libxml2 >>>>>> manual page).
-
-
-=item B<unbindNode>
-
- $node->unbindNode();
-
-Unbinds the Node from its siblings and Parent, but not from the Document it
-belongs to. If the node is not inserted into the DOM afterwards it will be lost
-after the program terminated. From a low level view, the unbound node is
-stripped from the context it is and inserted into a (hidden) document-fragment.
-
-
-=item B<removeChild>
-
- $childnode = $node->removeChild( $childnode );
-
-This will unbind the Child Node from its parent C<<<<<< $node >>>>>>. The function returns the unbound node. If C<<<<<< oldNode >>>>>> is not a child of the given Node the function will fail.
-
-
-=item B<replaceChild>
-
- $oldnode = $node->replaceChild( $newNode, $oldNode );
-
-Replaces the C<<<<<< $oldNode >>>>>> with the C<<<<<< $newNode >>>>>>. The C<<<<<< $oldNode >>>>>> will be unbound from the Node. This function differs from the DOM L2
-specification, in the case, if the new node is not part of the document, the
-node will be imported first.
-
-
-=item B<replaceNode>
-
- $node->replaceNode($newNode);
-
-This function is very similar to replaceChild(), but it replaces the node
-itself rather than a childnode. This is useful if a node found by any XPath
-function, should be replaced.
-
-
-=item B<appendChild>
-
- $childnode = $node->appendChild( $childnode );
-
-The function will add the C<<<<<< $childnode >>>>>> to the end of C<<<<<< $node >>>>>>'s children. The function should fail, if the new childnode is already a child
-of C<<<<<< $node >>>>>>. This function differs from the DOM L2 specification, in the case, if the new
-node is not part of the document, the node will be imported first.
-
-
-=item B<addChild>
-
- $childnode = $node->addChild( $chilnode );
-
-As an alternative to appendChild() one can use the addChild() function. This
-function is a bit faster, because it avoids all DOM conformity checks.
-Therefore this function is quite useful if one builds XML documents in memory
-where the order and ownership (C<<<<<< ownerDocument >>>>>>) is assured.
-
-addChild() uses libxml2's own xmlAddChild() function. Thus it has to be used
-with extra care: If a text node is added to a node and the node itself or its
-last childnode is as well a text node, the node to add will be merged with the
-one already available. The current node will be removed from memory after this
-action. Because perl is not aware of this action, the perl instance is still
-available. XML::LibXML will catch the loss of a node and refuse to run any
-function called on that node.
-
-
-
- my $t1 = $doc->createTextNode( "foo" );
- my $t2 = $doc->createTextNode( "bar" );
- $t1->addChild( $t2 ); # is OK
- my $val = $t2->nodeValue(); # will fail, script dies
-
-Also addChild() will not check if the added node belongs to the same document
-as the node it will be added to. This could lead to inconsistent documents and
-in more worse cases even to memory violations, if one does not keep track of
-this issue.
-
-Although this sounds like a lot of trouble, addChild() is useful if a document
-is built from a stream, such as happens sometimes in SAX handlers or filters.
-
-If you are not sure about the source of your nodes, you better stay with
-appendChild(), because this function is more user friendly in the sense of
-being more error tolerant.
-
-
-=item B<addNewChild>
-
- $node = $parent->addNewChild( $nsURI, $name );
-
-Similar to C<<<<<< addChild() >>>>>>, this function uses low level libxml2 functionality to provide faster
-interface for DOM building. I<<<<<< addNewChild() >>>>>> uses C<<<<<< xmlNewChild() >>>>>> to create a new node on a given parent element.
-
-addNewChild() has two parameters $nsURI and $name, where $nsURI is an
-(optional) namespace URI. $name is the fully qualified element name;
-addNewChild() will determine the correct prefix if necessary.
-
-The function returns the newly created node.
-
-This function is very useful for DOM building, where a created node can be
-directly associated with its parent. I<<<<<< NOTE >>>>>> this function is not part of the DOM specification and its use will limit your
-code to XML::LibXML.
-
-
-=item B<addSibling>
-
- $node->addSibling($newNode);
-
-addSibling() allows adding an additional node to the end of a nodelist, defined
-by the given node.
-
-
-=item B<cloneNode>
-
- $newnode =$node->cloneNode( $deep );
-
-I<<<<<< cloneNode >>>>>> creates a copy of C<<<<<< $node >>>>>>. When $deep is set to 1 (true) the function will copy all childnodes as well.
-If $deep is 0 only the current node will be copied. Note that in case of
-element, attributes are copied even if $deep is 0.
-
-Note that the behavior of this function for $deep=0 has changed in 1.62 in
-order to be consistent with the DOM spec (in older versions attributes and
-namespace information was not copied for elements).
-
-
-=item B<parentNode>
-
- $parentnode = $node->parentNode;
-
-Returns simply the Parent Node of the current node.
-
-
-=item B<nextSibling>
-
- $nextnode = $node->nextSibling();
-
-Returns the next sibling if any .
-
-
-=item B<previousSibling>
-
- $prevnode = $node->previousSibling();
-
-Analogous to I<<<<<< getNextSibling >>>>>> the function returns the previous sibling if any.
-
-
-=item B<hasChildNodes>
-
- $boolean = $node->hasChildNodes();
-
-If the current node has Childnodes this function returns TRUE (1), otherwise it
-returns FALSE (0, not undef).
-
-
-=item B<firstChild>
-
- $childnode = $node->firstChild;
-
-If a node has childnodes this function will return the first node in the
-childlist.
-
-
-=item B<lastChild>
-
- $childnode = $node->lastChild;
-
-If the C<<<<<< $node >>>>>> has childnodes this function returns the last child node.
-
-
-=item B<ownerDocument>
-
- $documentnode = $node->ownerDocument;
-
-Through this function it is always possible to access the document the current
-node is bound to.
-
-
-=item B<getOwner>
-
- $node = $node->getOwner;
-
-This function returns the node the current node is associated with. In most
-cases this will be a document node or a document fragment node.
-
-
-=item B<setOwnerDocument>
-
- $node->setOwnerDocument( $doc );
-
-This function binds a node to another DOM. This method unbinds the node first,
-if it is already bound to another document.
-
-This function is the opposite calling of L<<<<<< XML::LibXML DOM Document Class|XML::LibXML DOM Document Class >>>>>>'s adoptNode() function. Because of this it has the same limitations with
-Entity References as adoptNode().
-
-
-=item B<insertBefore>
-
- $node->insertBefore( $newNode, $refNode );
-
-The method inserts C<<<<<< $newNode >>>>>> before C<<<<<< $refNode >>>>>>. If C<<<<<< $refNode >>>>>> is undefined, the newNode will be set as the new last child of the parent node.
-This function differs from the DOM L2 specification, in the case, if the new
-node is not part of the document, the node will be imported first,
-automatically.
-
-$refNode has to be passed to the function even if it is undefined:
-
-
-
- $node->insertBefore( $newNode, undef ); # the same as $node->appendChild( $newNode );
- $node->insertBefore( $newNode ); # wrong
-
-Note, that the reference node has to be a direct child of the node the function
-is called on. Also, $newChild is not allowed to be an ancestor of the new
-parent node.
-
-
-=item B<insertAfter>
-
- $node->insertAfter( $newNode, $refNode );
-
-The method inserts C<<<<<< $newNode >>>>>> after C<<<<<< $refNode >>>>>>. If C<<<<<< $refNode >>>>>> is undefined, the newNode will be set as the new last child of the parent node.
-
-Note, that $refNode has to be passed explicitly even if it is undef.
-
-
-=item B<findnodes>
-
- @nodes = $node->findnodes( $xpath_expression );
-
-I<<<<<< findnodes >>>>>> evaluates the xpath expression (XPath 1.0) on the current node and returns the
-resulting node set as an array. In scalar context returns a L<<<<<< XML::LibXML::NodeList|XML::LibXML::NodeList >>>>>> object.
-
-I<<<<<< NOTE ON NAMESPACES AND XPATH >>>>>>:
-
-A common mistake about XPath is to assume that node tests consisting of an
-element name with no prefix match elements in the default namespace. This
-assumption is wrong - by XPath specification, such node tests can only match
-elements that are in no (i.e. null) namespace.
-
-So, for example, one cannot match the root element of an XHTML document with C<<<<<< $node->find('/html') >>>>>> since C<<<<<< '/html' >>>>>> would only match if the root element C<<<<<< <html> >>>>>> had no namespace, but all XHTML elements belong to the namespace
-http://www.w3.org/1999/xhtml. (Note that C<<<<<< xmlns="..." >>>>>> namespace declarations can also be specified in a DTD, which makes the
-situation even worse, since the XML document looks as if there was no default
-namespace).
-
-There are several possible ways to deal with namespaces in XPath:
-
-
-=over 4
-
-=item *
-
-The recommended way is to use the L<<<<<< XPath Evaluation|XPath Evaluation >>>>>> module to define an explicit context for XPath evaluation, in which a document
-independent prefix-to-namespace mapping can be defined. For example:
-
-
-
- my $xpc = XML::LibXML::XPathContext->new;
- $xpc->registerNs('x', 'http://www.w3.org/1999/xhtml');
- $xpc->find('/x:html',$node);
-
-
-
-=item *
-
-Another possibility is to use prefixes declared in the queried document (if
-known). If the document declares a prefix for the namespace in question (and
-the context node is in the scope of the declaration), C<<<<<< XML::LibXML >>>>>> allows you to use the prefix in the XPath expression, e.g.:
-
-
-
- $node->find('/x:html');
-
-
-
-=back
-
-See also XML::LibXML::XPathContext->findnodes.
-
-
-=item B<find>
-
- $result = $node->find( $xpath );
-
-I<<<<<< find >>>>>> evaluates the XPath 1.0 expression using the current node as the context of the
-expression, and returns the result depending on what type of result the XPath
-expression had. For example, the XPath "1 * 3 + 52" results in a L<<<<<< XML::LibXML::Number|XML::LibXML::Number >>>>>> object being returned. Other expressions might return a L<<<<<< XML::LibXML::Boolean|XML::LibXML::Boolean >>>>>> object, or a L<<<<<< XML::LibXML::Literal|XML::LibXML::Literal >>>>>> object (a string). Each of those objects uses Perl's overload feature to "do
-the right thing" in different contexts.
-
-See also L<<<<<< XPath Evaluation|XPath Evaluation >>>>>>->find.
-
-
-=item B<findvalue>
-
- print $node->findvalue( $xpath );
-
-I<<<<<< findvalue >>>>>> is exactly equivalent to:
-
-
-
- $node->find( $xpath )->to_literal;
-
-That is, it returns the literal value of the results. This enables you to
-ensure that you get a string back from your search, allowing certain shortcuts.
-This could be used as the equivalent of XSLT's <xsl:value-of
-select="some_xpath"/>.
-
-See also L<<<<<< XPath Evaluation|XPath Evaluation >>>>>>->findvalue.
-
-
-=item B<childNodes>
-
- @childnodes = $node->childNodes;
-
-I<<<<<< getChildnodes >>>>>> implements a more intuitive interface to the childnodes of the current node. It
-enables you to pass all children directly to a C<<<<<< map >>>>>> or C<<<<<< grep >>>>>>. If this function is called in scalar context, a L<<<<<< XML::LibXML::NodeList|XML::LibXML::NodeList >>>>>> object will be returned.
-
-
-=item B<toString>
-
- $xmlstring = $node->toString($format,$docencoding);
-
-This method is similar to the method C<<<<<< toString >>>>>> of a L<<<<<< XML::LibXML DOM Document Class|XML::LibXML DOM Document Class >>>>>> but for a single node. It returns a string consisting of XML serialization of
-the given node and all its descendants. Unlike C<<<<<< XML::LibXML::Document::toString >>>>>>, in this case the resulting string is by default a character string (UTF-8
-encoded with UTF8 flag on). An optional flag $format controls indentation, as
-in C<<<<<< XML::LibXML::Document::toString >>>>>>. If the second optional $docencoding flag is true, the result will be a byte
-string in the document encoding (see C<<<<<< XML::LibXML::Document::actualEncoding >>>>>>).
-
-
-=item B<toStringC14N>
-
- $c14nstring = $node->toStringC14N($with_comments, $xpath_expression);
-
-The function is similar to toString(). Instead of simply serializing the
-document tree, it transforms it as it is specified in the XML-C14N
-Specification (see L<<<<<< http://www.w3.org/TR/xml-c14n|http://www.w3.org/TR/xml-c14n >>>>>>). Such transformation is known as canonization.
-
-If $with_comments is 0 or not defined, the result-document will not contain any
-comments that exist in the original document. To include comments into the
-canonized document, $with_comments has to be set to 1.
-
-The parameter $xpath_expression defines the nodeset of nodes that should be
-visible in the resulting document. This can be used to filter out some nodes.
-One has to note, that only the nodes that are part of the nodeset, will be
-included into the result-document. Their child-nodes will not exist in the
-resulting document, unless they are part of the nodeset defined by the xpath
-expression.
-
-If $xpath_expression is omitted or empty, toStringC14N() will include all nodes
-in the given sub-tree.
-
-
-=item B<toStringEC14N>
-
- $ec14nstring = $node->toStringEC14N($with_comments, $xpath_expression, $inclusive_prefix_list);
-
-The function is similar to toStringC14N() but follows the XML-EXC-C14N
-Specification (see L<<<<<< http://www.w3.org/TR/xml-exc-c14n|http://www.w3.org/TR/xml-exc-c14n >>>>>>) for exclusive canonization of XML.
-
-The first two arguments are as above. If $inclusive_prefix_list is used, it
-should be an ARRAY reference listing namespace prefixes that are to be handled
-in the manner described by the Canonical XML Recommendation (i.e. preserved in
-the output even if the namespace is not used). C.f. the spec for details.
-
-
-=item B<serialize>
-
- $str = $doc->serialize($format);
-
-An alias for toString(). This function was name added to be more consistent
-with libxml2.
-
-
-=item B<serialize_c14n>
-
- $c14nstr = $doc->serialize_c14n($comment_flag,$xpath);
-
-An alias for toStringC14N().
-
-
-=item B<serialize_exc_c14n>
-
- $ec14nstr = $doc->serialize_ec14n($comment_flag,$xpath,$inclusive_prefix_list);
-
-An alias for toStringEC14N().
-
-
-=item B<localname>
-
- $localname = $node->localname;
-
-Returns the local name of a tag. This is the part behind the colon.
-
-
-=item B<prefix>
-
- $nameprefix = $node->prefix;
-
-Returns the prefix of a tag. This is the part before the colon.
-
-
-=item B<namespaceURI>
-
- $uri = $node->namespaceURI();
-
-returns the URI of the current namespace.
-
-
-=item B<hasAttributes>
-
- $boolean = $node->hasAttributes();
-
-returns 1 (TRUE) if the current node has any attributes set, otherwise 0
-(FALSE) is returned.
-
-
-=item B<attributes>
-
- @attributelist = $node->attributes();
-
-This function returns all attributes and namespace declarations assigned to the
-given node.
-
-Because XML::LibXML does not implement namespace declarations and attributes
-the same way, it is required to test what kind of node is handled while
-accessing the functions result.
-
-If this function is called in array context the attribute nodes are returned as
-an array. In scalar context the function will return a L<<<<<< XML::LibXML::NamedNodeMap|XML::LibXML::NamedNodeMap >>>>>> object.
-
-
-=item B<lookupNamespaceURI>
-
- $URI = $node->lookupNamespaceURI( $prefix );
-
-Find a namespace URI by its prefix starting at the current node.
-
-
-=item B<lookupNamespacePrefix>
-
- $prefix = $node->lookupNamespacePrefix( $URI );
-
-Find a namespace prefix by its URI starting at the current node.
-
-I<<<<<< NOTE >>>>>> Only the namespace URIs are meant to be unique. The prefix is only document
-related. Also the document might have more than a single prefix defined for a
-namespace.
-
-
-=item B<normalize>
-
- $node->normalize;
-
-This function normalizes adjacent text nodes. This function is not as strict as
-libxml2's xmlTextMerge() function, since it will not free a node that is still
-referenced by the perl layer.
-
-
-=item B<getNamespaces>
-
- @nslist = $node->getNamespaces;
-
-If a node has any namespaces defined, this function will return these
-namespaces. Note, that this will not return all namespaces that are in scope,
-but only the ones declared explicitly for that node.
-
-Although getNamespaces is available for all nodes, it only makes sense if used
-with element nodes.
-
-
-=item B<removeChildNodes>
-
- $node->removeChildNodes();
-
-This function is not specified for any DOM level: It removes all childnodes
-from a node in a single step. Other than the libxml2 function itself
-(xmlFreeNodeList), this function will not immediately remove the nodes from the
-memory. This saves one from getting memory violations, if there are nodes still
-referred to from the Perl level.
-
-
-=item B<nodePath>
-
- $node->nodePath();
-
-This function is not specified for any DOM level: It returns a canonical
-structure based XPath for a given node.
-
-
-=item B<line_number>
-
- $lineno = $node->line_number();
-
-This function returns the line number where the tag was found during parsing.
-If a node is added to the document the line number is 0. Problems may occur, if
-a node from one document is passed to another one.
-
-IMPORTANT: Due to limitations in the libxml2 library line numbers greater than
-65535 will be returned as 65535. Please see L<<<<<< http://bugzilla.gnome.org/show_bug.cgi?id=325533|http://bugzilla.gnome.org/show_bug.cgi?id=325533 >>>>>> for more details.
-
-Note: line_number() is special to XML::LibXML and not part of the DOM
-specification.
-
-If the line_numbers flag of the parser was not activated before parsing,
-line_number() will always return 0.
-
-
-
-=back
-
-=head1 AUTHORS
-
-Matt Sergeant,
-Christian Glahn,
-Petr Pajas
-
-
-=head1 VERSION
-
-1.66
-
-=head1 COPYRIGHT
-
-2001-2007, AxKit.com Ltd; 2002-2006 Christian Glahn; 2006-2008 Petr Pajas, All rights reserved.
-
-=cut
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/NodeList.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/NodeList.pm
deleted file mode 100644
index 466efb04bef..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/NodeList.pm
+++ /dev/null
@@ -1,191 +0,0 @@
-# $Id: NodeList.pm 709 2008-01-29 21:01:32Z pajas $
-
-package XML::LibXML::NodeList;
-use strict;
-use XML::LibXML::Boolean;
-use XML::LibXML::Literal;
-use XML::LibXML::Number;
-
-use vars qw ($VERSION);
-$VERSION = "1.66"; # VERSION TEMPLATE: DO NOT CHANGE
-
-use overload
- '""' => \&to_literal,
- 'bool' => \&to_boolean,
- ;
-
-sub new {
- my $class = shift;
- bless [@_], $class;
-}
-
-sub new_from_ref {
- my ($class,$array_ref,$reuse) = @_;
- return bless $reuse ? $array_ref : [@$array_ref], $class;
-}
-
-sub pop {
- my $self = CORE::shift;
- CORE::pop @$self;
-}
-
-sub push {
- my $self = CORE::shift;
- CORE::push @$self, @_;
-}
-
-sub append {
- my $self = CORE::shift;
- my ($nodelist) = @_;
- CORE::push @$self, $nodelist->get_nodelist;
-}
-
-sub shift {
- my $self = CORE::shift;
- CORE::shift @$self;
-}
-
-sub unshift {
- my $self = CORE::shift;
- CORE::unshift @$self, @_;
-}
-
-sub prepend {
- my $self = CORE::shift;
- my ($nodelist) = @_;
- CORE::unshift @$self, $nodelist->get_nodelist;
-}
-
-sub size {
- my $self = CORE::shift;
- scalar @$self;
-}
-
-sub get_node {
- # uses array index starting at 1, not 0
- # this is mainly because of XPath.
- my $self = CORE::shift;
- my ($pos) = @_;
- $self->[$pos - 1];
-}
-
-*item = \&get_node;
-
-sub get_nodelist {
- my $self = CORE::shift;
- @$self;
-}
-
-sub to_boolean {
- my $self = CORE::shift;
- return (@$self > 0) ? XML::LibXML::Boolean->True : XML::LibXML::Boolean->False;
-}
-
-# string-value of a nodelist is the string-value of the first node
-sub string_value {
- my $self = CORE::shift;
- return '' unless @$self;
- return $self->[0]->string_value;
-}
-
-sub to_literal {
- my $self = CORE::shift;
- return XML::LibXML::Literal->new(
- join('', grep {defined $_} map { $_->string_value } @$self)
- );
-}
-
-sub to_number {
- my $self = CORE::shift;
- return XML::LibXML::Number->new(
- $self->to_literal
- );
-}
-
-sub iterator {
- warn "this function is obsolete!\nIt was disabled in version 1.54\n";
- return undef;
-}
-
-1;
-__END__
-
-=head1 NAME
-
-XML::LibXML::NodeList - a list of XML document nodes
-
-=head1 DESCRIPTION
-
-An XML::LibXML::NodeList object contains an ordered list of nodes, as
-detailed by the W3C DOM documentation of Node Lists.
-
-=head1 SYNOPSIS
-
- my $results = $dom->findnodes('//somepath');
- foreach my $context ($results->get_nodelist) {
- my $newresults = $context->findnodes('./other/element');
- ...
- }
-
-=head1 API
-
-=head2 new()
-
-You will almost never have to create a new NodeSet object, as it is all
-done for you by XPath.
-
-=head2 get_nodelist()
-
-Returns a list of nodes, the contents of the node list, as a perl list.
-
-=head2 string_value()
-
-Returns the string-value of the first node in the list.
-See the XPath specification for what "string-value" means.
-
-=head2 to_literal()
-
-Returns the concatenation of all the string-values of all
-the nodes in the list.
-
-=head2 get_node($pos)
-
-Returns the node at $pos. The node position in XPath is based at 1, not 0.
-
-=head2 size()
-
-Returns the number of nodes in the NodeSet.
-
-=head2 pop()
-
-Equivalent to perl's pop function.
-
-=head2 push(@nodes)
-
-Equivalent to perl's push function.
-
-=head2 append($nodelist)
-
-Given a nodelist, appends the list of nodes in $nodelist to the end of the
-current list.
-
-=head2 shift()
-
-Equivalent to perl's shift function.
-
-=head2 unshift(@nodes)
-
-Equivalent to perl's unshift function.
-
-=head2 prepend($nodeset)
-
-Given a nodelist, prepends the list of nodes in $nodelist to the front of
-the current list.
-
-=head2 iterator()
-
-Will return a new nodelist iterator for the current nodelist. A
-nodelist iterator is usefull if more complex nodelist processing is
-needed.
-
-=cut
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/Number.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/Number.pm
deleted file mode 100644
index 4ba448ab600..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/Number.pm
+++ /dev/null
@@ -1,90 +0,0 @@
-# $Id: Number.pm 709 2008-01-29 21:01:32Z pajas $
-
-package XML::LibXML::Number;
-use XML::LibXML::Boolean;
-use XML::LibXML::Literal;
-use strict;
-
-use vars qw ($VERSION);
-$VERSION = "1.66"; # VERSION TEMPLATE: DO NOT CHANGE
-
-use overload
- '""' => \&value,
- '0+' => \&value,
- '<=>' => \&cmp;
-
-sub new {
- my $class = shift;
- my $number = shift;
- if ($number !~ /^\s*(-\s*)?(\d+(\.\d*)?|\.\d+)\s*$/) {
- $number = undef;
- }
- else {
- $number =~ s/\s+//g;
- }
- bless \$number, $class;
-}
-
-sub as_string {
- my $self = shift;
- defined $$self ? $$self : 'NaN';
-}
-
-sub as_xml {
- my $self = shift;
- return "<Number>" . (defined($$self) ? $$self : 'NaN') . "</Number>\n";
-}
-
-sub value {
- my $self = shift;
- $$self;
-}
-
-sub cmp {
- my $self = shift;
- my ($other, $swap) = @_;
- if ($swap) {
- return $other <=> $$self;
- }
- return $$self <=> $other;
-}
-
-sub evaluate {
- my $self = shift;
- $self;
-}
-
-sub to_boolean {
- my $self = shift;
- return $$self ? XML::LibXML::Boolean->True : XML::LibXML::Boolean->False;
-}
-
-sub to_literal { XML::LibXML::Literal->new($_[0]->as_string); }
-sub to_number { $_[0]; }
-
-sub string_value { return $_[0]->value }
-
-1;
-__END__
-
-=head1 NAME
-
-XML::LibXML::Number - Simple numeric values.
-
-=head1 DESCRIPTION
-
-This class holds simple numeric values. It doesn't support -0, +/- Infinity,
-or NaN, as the XPath spec says it should, but I'm not hurting anyone I don't think.
-
-=head1 API
-
-=head2 new($num)
-
-Creates a new XML::LibXML::Number object, with the value in $num. Does some
-rudimentary numeric checking on $num to ensure it actually is a number.
-
-=head2 value()
-
-Also as overloaded stringification. Returns the numeric value held.
-
-=cut
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/PI.pod b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/PI.pod
deleted file mode 100644
index 6839a310ab2..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/PI.pod
+++ /dev/null
@@ -1,83 +0,0 @@
-=head1 NAME
-
-XML::LibXML::PI - XML::LibXML Processing Instructions
-
-=head1 SYNOPSIS
-
-
-
- use XML::LibXML;
- # Only methods specific to Processing Instruction nodes are listed here,
- # see XML::LibXML::Node manpage for other methods
-
- $pinode->setData( $data_string );
- $pinode->setData( name=>string_value [...] );
-
-=head1 DESCRIPTION
-
-Processing instructions are implemented with XML::LibXML with read and write
-access. The PI data is the PI without the PI target (as specified in XML 1.0
-[17]) as a string. This string can be accessed with getData as implemented in L<<<<<< Abstract Base Class of XML::LibXML Nodes|Abstract Base Class of XML::LibXML Nodes >>>>>>.
-
-The write access is aware about the fact, that many processing instructions
-have attribute like data. Therefore setData() provides besides the DOM spec
-conform Interface to pass a set of named parameter. So the code segment
-
-
-
- my $pi = $dom->createProcessingInstruction("abc");
- $pi->setData(foo=>'bar', foobar=>'foobar');
- $dom->appendChild( $pi );
-
-will result the following PI in the DOM:
-
-
-
- <?abc foo="bar" foobar="foobar"?>
-
-Which is how it is specified in the DOM specification. This three step
-interface creates temporary a node in perl space. This can be avoided while
-using the insertProcessingInstruction() method. Instead of the three calls
-described above, the call
-
-
-
- $dom->insertProcessingInstruction("abc",'foo="bar" foobar="foobar"');
-
-will have the same result as above.
-
-L<<<<<< XML::LibXML Processing Instructions|XML::LibXML Processing Instructions >>>>>>'s implementation of setData() documented below differs a bit from the the
-standard version as available in L<<<<<< Abstract Base Class of XML::LibXML Nodes|Abstract Base Class of XML::LibXML Nodes >>>>>>:
-
-=over 4
-
-=item B<setData>
-
- $pinode->setData( $data_string );
- $pinode->setData( name=>string_value [...] );
-
-This method allows to change the content data of a PI. Additionally to the
-interface specified for DOM Level2, the method provides a named parameter
-interface to set the data. This parameter list is converted into a string
-before it is appended to the PI.
-
-
-
-=back
-
-=head1 AUTHORS
-
-Matt Sergeant,
-Christian Glahn,
-Petr Pajas
-
-
-=head1 VERSION
-
-1.66
-
-=head1 COPYRIGHT
-
-2001-2007, AxKit.com Ltd; 2002-2006 Christian Glahn; 2006-2008 Petr Pajas, All rights reserved.
-
-=cut
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/Parser.pod b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/Parser.pod
deleted file mode 100644
index e8aa32cf449..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/Parser.pod
+++ /dev/null
@@ -1,683 +0,0 @@
-=head1 NAME
-
-XML::LibXML::Parser - Parsing XML Data with XML::LibXML
-
-=head1 SYNOPSIS
-
-
-
- use XML::LibXML;
- my $parser = XML::LibXML->new();
-
- my $doc = $parser->parse_string(<<'EOT');
- <some-xml/>
- EOT
- my $fdoc = $parser->parse_file( $xmlfile );
-
- my $fhdoc = $parser->parse_fh( $xmlstream );
-
- my $fragment = $parser->parse_xml_chunk( $xml_wb_chunk );
-
- $parser = XML::LibXML->new();
- $doc = $parser->parse_file( $xmlfilename );
- $doc = $parser->parse_fh( $io_fh );
- $doc = $parser->parse_string( $xmlstring);
- $doc = $parser->parse_html_file( $htmlfile, \%opts );
- $doc = $parser->parse_html_fh( $io_fh, \%opts );
- $doc = $parser->parse_html_string( $htmlstring, \%opts );
- $fragment = $parser->parse_balanced_chunk( $wbxmlstring );
- $fragment = $parser->parse_xml_chunk( $wbxmlstring );
- $parser->process_xincludes( $doc );
- $parser->processXIncludes( $doc );
- $parser->parse_chunk($string, $terminate);
- $parser->start_push();
- $parser->push(@data);
- $doc = $parser->finish_push( $recover );
- $parser->validation(1);
- $parser->recover(1);
- $parser->recover_silently(1);
- $parser->expand_entities(0);
- $parser->keep_blanks(0);
- $parser->pedantic_parser(1);
- $parser->line_numbers(1);
- $parser->load_ext_dtd(1);
- $parser->complete_attributes(1);
- $parser->expand_xinclude(1);
- $parser->load_catalog( $catalog_file );
- $parser->base_uri( $your_base_uri );
- $parser->gdome_dom(1);
- $parser->clean_namespaces( 1 );
- $parser->no_network(1);
-
-=head1 PARSING
-
-A XML document is read into a data structure such as a DOM tree by a piece of
-software, called a parser. XML::LibXML currently provides four different parser
-interfaces:
-
-
-=over 4
-
-=item *
-
-A DOM Pull-Parser
-
-
-
-=item *
-
-A DOM Push-Parser
-
-
-
-=item *
-
-A SAX Parser
-
-
-
-=item *
-
-A DOM based SAX Parser.
-
-
-
-=back
-
-
-=head2 Creating a Parser Instance
-
-XML::LibXML provides an OO interface to the libxml2 parser functions. Thus you
-have to create a parser instance before you can parse any XML data.
-
-=over 4
-
-=item B<new>
-
- $parser = XML::LibXML->new();
-
-There is nothing much to say about the constructor. It simply creates a new
-parser instance.
-
-Although libxml2 uses mainly global flags to alter the behaviour of the parser,
-each XML::LibXML parser instance has its own flags or callbacks and does not
-interfere with other instances.
-
-
-
-=back
-
-
-=head2 DOM Parser
-
-One of the common parser interfaces of XML::LibXML is the DOM parser. This
-parser reads XML data into a DOM like data structure, so each tag can get
-accessed and transformed.
-
-XML::LibXML's DOM parser is not only capable to parse XML data, but also
-(strict) HTML files. There are three ways to parse documents - as a string, as
-a Perl filehandle, or as a filename/URL. The return value from each is a L<<<<<< XML::LibXML DOM Document Class|XML::LibXML DOM Document Class >>>>>> object, which is a DOM object.
-
-All of the functions listed below will throw an exception if the document is
-invalid. To prevent this causing your program exiting, wrap the call in an
-eval{} block
-
-=over 4
-
-=item B<parse_file>
-
- $doc = $parser->parse_file( $xmlfilename );
-
-This function parses an XML document from a file or network; $xmlfilename can
-be either a filename or an URL. Note that for parsing files, this function is
-the fastest choice, about 6-8 times faster then parse_fh().
-
-
-=item B<parse_fh>
-
- $doc = $parser->parse_fh( $io_fh );
-
-parse_fh() parses a IOREF or a subclass of IO::Handle.
-
-Because the data comes from an open handle, libxml2's parser does not know
-about the base URI of the document. To set the base URI one should use
-parse_fh() as follows:
-
-
-
- my $doc = $parser->parse_fh( $io_fh, $baseuri );
-
-
-=item B<parse_string>
-
- $doc = $parser->parse_string( $xmlstring);
-
-This function is similar to parse_fh(), but it parses a XML document that is
-available as a single string in memory. Again, you can pass an optional base
-URI to the function.
-
-
-
- my $doc = $parser->parse_string( $xmlstring, $baseuri );
-
-
-=item B<parse_html_file>
-
- $doc = $parser->parse_html_file( $htmlfile, \%opts );
-
-Similar to parse_file() but parses HTML (strict) documents; $htmlfile can be
-filename or URL.
-
-An optional second argument can be used to pass some options to the HTML parser
-as a HASH reference. Possible options are: Possible options are: encoding and
-URI for libxml2 < 2.6.27, and for later versions of libxml2 additionally:
-recover, suppress_errors, suppress_warnings, pedantic_parser, no_blanks, and
-no_network.
-
-
-=item B<parse_html_fh>
-
- $doc = $parser->parse_html_fh( $io_fh, \%opts );
-
-Similar to parse_fh() but parses HTML (strict) streams.
-
-An optional second argument can be used to pass some options to the HTML parser
-as a HASH reference. Possible options are: encoding and URI for libxml2 <
-2.6.27, and for later versions of libxml2 additionally: recover,
-suppress_errors, suppress_warnings, pedantic_parser, no_blanks, and no_network.
-Note: encoding option may not work correctly with this function in libxml2 <
-2.6.27 if the HTML file declares charset using a META tag.
-
-
-=item B<parse_html_string>
-
- $doc = $parser->parse_html_string( $htmlstring, \%opts );
-
-Similar to parse_string() but parses HTML (strict) strings.
-
-An optional second argument can be used to pass some options to the HTML parser
-as a HASH reference. Possible options are: encoding and URI for libxml2 <
-2.6.27, and for later versions of libxml2 additionally: recover,
-suppress_errors, suppress_warnings, pedantic_parser, no_blanks, and no_network.
-
-
-
-=back
-
-Parsing HTML may cause problems, especially if the ampersand ('&') is used.
-This is a common problem if HTML code is parsed that contains links to
-CGI-scripts. Such links cause the parser to throw errors. In such cases libxml2
-still parses the entire document as there was no error, but the error causes
-XML::LibXML to stop the parsing process. However, the document is not lost.
-Such HTML documents should be parsed using the I<<<<<< recover >>>>>> flag. By default recovering is deactivated.
-
-The functions described above are implemented to parse well formed documents.
-In some cases a program gets well balanced XML instead of well formed documents
-(e.g. a XML fragment from a Database). With XML::LibXML it is not required to
-wrap such fragments in the code, because XML::LibXML is capable even to parse
-well balanced XML fragments.
-
-=over 4
-
-=item B<parse_balanced_chunk>
-
- $fragment = $parser->parse_balanced_chunk( $wbxmlstring );
-
-This function parses a well balanced XML string into a L<<<<<< XML::LibXML's DOM L2 Document Fragment Implementation|XML::LibXML's DOM L2 Document Fragment Implementation >>>>>>.
-
-
-=item B<parse_xml_chunk>
-
- $fragment = $parser->parse_xml_chunk( $wbxmlstring );
-
-This is the old name of parse_balanced_chunk(). Because it may causes confusion
-with the push parser interface, this function should not be used anymore.
-
-
-
-=back
-
-By default XML::LibXML does not process XInclude tags within a XML Document
-(see options section below). XML::LibXML allows to post process a document to
-expand XInclude tags.
-
-=over 4
-
-=item B<process_xincludes>
-
- $parser->process_xincludes( $doc );
-
-After a document is parsed into a DOM structure, you may want to expand the
-documents XInclude tags. This function processes the given document structure
-and expands all XInclude tags (or throws an error) by using the flags and
-callbacks of the given parser instance.
-
-Note that the resulting Tree contains some extra nodes (of type
-XML_XINCLUDE_START and XML_XINCLUDE_END) after successfully processing the
-document. These nodes indicate where data was included into the original tree.
-if the document is serialized, these extra nodes will not show up.
-
-Remember: A Document with processed XIncludes differs from the original
-document after serialization, because the original XInclude tags will not get
-restored!
-
-If the parser flag "expand_xincludes" is set to 1, you need not to post process
-the parsed document.
-
-
-=item B<processXIncludes>
-
- $parser->processXIncludes( $doc );
-
-This is an alias to process_xincludes, but through a JAVA like function name.
-
-
-
-=back
-
-
-=head2 Push Parser
-
-XML::LibXML provides a push parser interface. Rather than pulling the data from
-a given source the push parser waits for the data to be pushed into it.
-
-This allows one to parse large documents without waiting for the parser to
-finish. The interface is especially useful if a program needs to pre-process
-the incoming pieces of XML (e.g. to detect document boundaries).
-
-While XML::LibXML parse_*() functions force the data to be a well-formed XML,
-the push parser will take any arbitrary string that contains some XML data. The
-only requirement is that all the pushed strings are together a well formed
-document. With the push parser interface a program can interrupt the parsing
-process as required, where the parse_*() functions give not enough flexibility.
-
-Different to the pull parser implemented in parse_fh() or parse_file(), the
-push parser is not able to find out about the documents end itself. Thus the
-calling program needs to indicate explicitly when the parsing is done.
-
-In XML::LibXML this is done by a single function:
-
-=over 4
-
-=item B<parse_chunk>
-
- $parser->parse_chunk($string, $terminate);
-
-parse_chunk() tries to parse a given chunk of data, which isn't necessarily
-well balanced data. The function takes two parameters: The chunk of data as a
-string and optional a termination flag. If the termination flag is set to a
-true value (e.g. 1), the parsing will be stopped and the resulting document
-will be returned as the following example describes:
-
-
-
- my $parser = XML::LibXML->new;
- for my $string ( "<", "foo", ' bar="hello world"', "/>") {
- $parser->parse_chunk( $string );
- }
- my $doc = $parser->parse_chunk("", 1); # terminate the parsing
-
-
-
-=back
-
-Internally XML::LibXML provides three functions that control the push parser
-process:
-
-=over 4
-
-=item B<start_push>
-
- $parser->start_push();
-
-Initializes the push parser.
-
-
-=item B<push>
-
- $parser->push(@data);
-
-This function pushes the data stored inside the array to libxml2's parser. Each
-entry in @data must be a normal scalar!
-
-
-=item B<finish_push>
-
- $doc = $parser->finish_push( $recover );
-
-This function returns the result of the parsing process. If this function is
-called without a parameter it will complain about non well-formed documents. If
-$restore is 1, the push parser can be used to restore broken or non well formed
-(XML) documents as the following example shows:
-
-
-
- eval {
- $parser->push( "<foo>", "bar" );
- $doc = $parser->finish_push(); # will report broken XML
- };
- if ( $@ ) {
- # ...
- }
-
-This can be annoying if the closing tag is missed by accident. The following
-code will restore the document:
-
-
-
- eval {
- $parser->push( "<foo>", "bar" );
- $doc = $parser->finish_push(1); # will return the data parsed
- # unless an error happened
- };
-
- print $doc->toString(); # returns "<foo>bar</foo>"
-
-Of course finish_push() will return nothing if there was no data pushed to the
-parser before.
-
-
-
-=back
-
-
-=head2 DOM based SAX Parser
-
-XML::LibXML provides a DOM based SAX parser. The SAX parser is defined in the
-module XML::LibXML::SAX::Parser. As it is not a stream based parser, it parses
-documents into a DOM and traverses the DOM tree instead.
-
-The API of this parser is exactly the same as any other Perl SAX2 parser. See
-XML::SAX::Intro for details.
-
-Aside from the regular parsing methods, you can access the DOM tree traverser
-directly, using the generate() method:
-
-
-
- my $doc = build_yourself_a_document();
- my $saxparser = $XML::LibXML::SAX::Parser->new( ... );
- $parser->generate( $doc );
-
-This is useful for serializing DOM trees, for example that you might have done
-prior processing on, or that you have as a result of XSLT processing.
-
-I<<<<<< WARNING >>>>>>
-
-This is NOT a streaming SAX parser. As I said above, this parser reads the
-entire document into a DOM and serialises it. Some people couldn't read that in
-the paragraph above so I've added this warning.
-
-If you want a streaming SAX parser look at the L<<<<<< XML::LibXML direct SAX parser|XML::LibXML direct SAX parser >>>>>> man page
-
-
-=head1 SERIALIZATION
-
-XML::LibXML provides some functions to serialize nodes and documents. The
-serialization functions are described on the L<<<<<< Abstract Base Class of XML::LibXML Nodes|Abstract Base Class of XML::LibXML Nodes >>>>>> manpage or the L<<<<<< XML::LibXML DOM Document Class|XML::LibXML DOM Document Class >>>>>> manpage. XML::LibXML checks three global flags that alter the serialization
-process:
-
-
-=over 4
-
-=item *
-
-skipXMLDeclaration
-
-
-
-=item *
-
-skipDTD
-
-
-
-=item *
-
-setTagCompression
-
-
-
-=back
-
-of that three functions only setTagCompression is available for all
-serialization functions.
-
-Because XML::LibXML does these flags not itself, one has to define them locally
-as the following example shows:
-
-
-
- local $XML::LibXML::skipXMLDeclaration = 1;
- local $XML::LibXML::skipDTD = 1;
- local $XML::LibXML::setTagCompression = 1;
-
-If skipXMLDeclaration is defined and not '0', the XML declaration is omitted
-during serialization.
-
-If skipDTD is defined and not '0', an existing DTD would not be serialized with
-the document.
-
-If setTagCompression is defined and not '0' empty tags are displayed as open
-and closing tags rather than the shortcut. For example the empty tag I<<<<<< foo >>>>>> will be rendered as I<<<<<< <foo></foo> >>>>>> rather than I<<<<<< <foo/> >>>>>>.
-
-
-=head1 PARSER OPTIONS
-
-LibXML options are global (unfortunately this is a limitation of the underlying
-implementation, not this interface). They can either be set using
-$parser->option(...), or XML::LibXML->option(...), both are treated in the same
-manner. Note that even two parser processes will share some of the same
-options, so be careful out there!
-
-Every option returns the previous value, and can be called without parameters
-to get the current value.
-
-=over 4
-
-=item B<validation>
-
- $parser->validation(1);
-
-Turn validation on (or off). Defaults to off.
-
-
-=item B<recover>
-
- $parser->recover(1);
-
-Turn the parsers recover mode on (or off). Defaults to off.
-
-This allows one to parse broken XML data into memory. This switch will only
-work with XML data rather than HTML data. Also the validation will be switched
-off automatically.
-
-The recover mode helps to recover documents that are almost well-formed very
-efficiently. That is for example a document that forgets to close the document
-tag (or any other tag inside the document). The recover mode of XML::LibXML has
-problems restoring documents that are more like well balanced chunks.
-
-XML::LibXML will only parse until the first fatal error occurs, reporting
-recoverable parsing errors as warnings. To suppress these warnings use
-$parser->recover_silently(1); or, equivalently, $parser->recover(2).
-
-
-=item B<recover_silently>
-
- $parser->recover_silently(1);
-
-Turns the parser warnings off (or on). Defaults to on.
-
-This allows to switch off warnings printed to STDERR when parsing documents
-with recover(1).
-
-Please note that calling recover_silently(0) also turns the parser recover mode
-off and calling recover_silently(1) automatically activates the parser recover
-mode.
-
-
-=item B<expand_entities>
-
- $parser->expand_entities(0);
-
-Turn entity expansion on or off, enabled by default. If entity expansion is
-off, any external parsed entities in the document are left as entities.
-Probably not very useful for most purposes.
-
-
-=item B<keep_blanks>
-
- $parser->keep_blanks(0);
-
-Allows you to turn off XML::LibXML's default behaviour of maintaining
-white-space in the document.
-
-
-=item B<pedantic_parser>
-
- $parser->pedantic_parser(1);
-
-You can make XML::LibXML more pedantic if you want to.
-
-
-=item B<line_numbers>
-
- $parser->line_numbers(1);
-
-If this option is activated XML::LibXML will store the line number of a node.
-This gives more information where a validation error occurred. It could be also
-used to find out about the position of a node after parsing (see also
-XML::LibXML::Node::line_number()).
-
-IMPORTANT: Due to limitations in the libxml2 library line numbers greater than
-65535 will be returned as 65535. Please see L<<<<<< http://bugzilla.gnome.org/show_bug.cgi?id=325533|http://bugzilla.gnome.org/show_bug.cgi?id=325533 >>>>>> for more details.
-
-By default line numbering is switched off (0).
-
-
-=item B<load_ext_dtd>
-
- $parser->load_ext_dtd(1);
-
-Load external DTD subsets while parsing.
-
-This flag is also required for DTD Validation, to provide complete attribute,
-and to expand entities, regardless if the document has an internal subset. Thus
-switching off external DTD loading, will disable entity expansion, validation,
-and complete attributes on internal subsets as well.
-
-If you leave this parser flag untouched, everything will work, because the
-default is 1 (activated)
-
-
-=item B<complete_attributes>
-
- $parser->complete_attributes(1);
-
-Complete the elements attributes lists with the ones defaulted from the DTDs.
-By default, this option is enabled.
-
-
-=item B<expand_xinclude>
-
- $parser->expand_xinclude(1);
-
-Expands XIinclude tags immediately while parsing the document. This flag
-assures that the parser callbacks are used while parsing the included document.
-
-
-=item B<load_catalog>
-
- $parser->load_catalog( $catalog_file );
-
-Will use $catalog_file as a catalog during all parsing processes. Using a
-catalog will significantly speed up parsing processes if many external
-resources are loaded into the parsed documents (such as DTDs or XIncludes).
-
-Note that catalogs will not be available if an external entity handler was
-specified. At the current state it is not possible to make use of both types of
-resolving systems at the same time.
-
-
-=item B<base_uri>
-
- $parser->base_uri( $your_base_uri );
-
-In case of parsing strings or file handles, XML::LibXML doesn't know about the
-base uri of the document. To make relative references such as XIncludes work,
-one has to set a separate base URI, that is then used for the parsed documents.
-
-
-=item B<gdome_dom>
-
- $parser->gdome_dom(1);
-
-THIS FLAG IS EXPERIMENTAL!
-
-Although quite powerful XML:LibXML's DOM implementation is limited if one needs
-or wants full DOM level 2 or level 3 support. XML::GDOME is based on libxml2 as
-well but provides a rather complete DOM implementation by wrapping libgdome.
-This allows you to make use of XML::LibXML's full parser options and
-XML::GDOME's DOM implementation at the same time.
-
-To make use of this function, one has to install libgdome and configure
-XML::LibXML to use this library. For this you need to rebuild XML::LibXML!
-
-
-=item B<clean_namespaces>
-
- $parser->clean_namespaces( 1 );
-
-libxml2 2.6.0 and later allows to strip redundant namespace declarations from
-the DOM tree. To do this, one has to set clean_namespaces() to 1 (TRUE). By
-default no namespace cleanup is done.
-
-
-=item B<no_network>
-
- $parser->no_network(1);
-
-Turn networking support on or off, enabled by default. If networking is off,
-all attempts to fetch non-local resources (such as DTD or external entities)
-will fail (unless custom callbacks are defined). It may be necessary to use
-$parser->recover(1) for processing documents requiring such resources while
-networking is off.
-
-
-
-=back
-
-
-=head1 ERROR REPORTING
-
-XML::LibXML throws exceptions during parsing, validation or XPath processing
-(and some other occasions). These errors can be caught by using I<<<<<< eval >>>>>> blocks. The error then will be stored in I<<<<<< $@ >>>>>>.
-
-XML::LibXML throws errors as they occurs and does not wait if a user test for
-them. This is a very common misunderstanding in the use of XML::LibXML. If the
-eval is omitted, XML::LibXML will always halt your script by "croaking" (see
-Carp man page for details).
-
-Also note that an increasing number of functions throw errors if bad data is
-passed. If you cannot assure valid data passed to XML::LibXML you should eval
-these functions.
-
-Note: since version 1.59, get_last_error() is no longer available in
-XML::LibXML for thread-safety reasons.
-
-=head1 AUTHORS
-
-Matt Sergeant,
-Christian Glahn,
-Petr Pajas
-
-
-=head1 VERSION
-
-1.66
-
-=head1 COPYRIGHT
-
-2001-2007, AxKit.com Ltd; 2002-2006 Christian Glahn; 2006-2008 Petr Pajas, All rights reserved.
-
-=cut
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/Reader.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/Reader.pm
deleted file mode 100644
index 935d31a5644..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/Reader.pm
+++ /dev/null
@@ -1,222 +0,0 @@
-package XML::LibXML::Reader;
-use XML::LibXML;
-
-use strict;
-use warnings;
-
-use vars qw ($VERSION);
-$VERSION = "1.66"; # VERSION TEMPLATE: DO NOT CHANGE
-
-use Carp;
-use 5.008_000;
-use base qw(Exporter);
-use constant {
- XML_READER_TYPE_NONE => 0,
- XML_READER_TYPE_ELEMENT => 1,
- XML_READER_TYPE_ATTRIBUTE => 2,
- XML_READER_TYPE_TEXT => 3,
- XML_READER_TYPE_CDATA => 4,
- XML_READER_TYPE_ENTITY_REFERENCE => 5,
- XML_READER_TYPE_ENTITY => 6,
- XML_READER_TYPE_PROCESSING_INSTRUCTION => 7,
- XML_READER_TYPE_COMMENT => 8,
- XML_READER_TYPE_DOCUMENT => 9,
- XML_READER_TYPE_DOCUMENT_TYPE => 10,
- XML_READER_TYPE_DOCUMENT_FRAGMENT => 11,
- XML_READER_TYPE_NOTATION => 12,
- XML_READER_TYPE_WHITESPACE => 13,
- XML_READER_TYPE_SIGNIFICANT_WHITESPACE => 14,
- XML_READER_TYPE_END_ELEMENT => 15,
- XML_READER_TYPE_END_ENTITY => 16,
- XML_READER_TYPE_XML_DECLARATION => 17,
-
- XML_READER_NONE => -1,
- XML_READER_START => 0,
- XML_READER_ELEMENT => 1,
- XML_READER_END => 2,
- XML_READER_EMPTY => 3,
- XML_READER_BACKTRACK => 4,
- XML_READER_DONE => 5,
- XML_READER_ERROR => 6
-};
-use vars qw( @EXPORT @EXPORT_OK %EXPORT_TAGS );
-
-BEGIN {
-
-%EXPORT_TAGS = (
- types =>
- [qw(
- XML_READER_TYPE_NONE
- XML_READER_TYPE_ELEMENT
- XML_READER_TYPE_ATTRIBUTE
- XML_READER_TYPE_TEXT
- XML_READER_TYPE_CDATA
- XML_READER_TYPE_ENTITY_REFERENCE
- XML_READER_TYPE_ENTITY
- XML_READER_TYPE_PROCESSING_INSTRUCTION
- XML_READER_TYPE_COMMENT
- XML_READER_TYPE_DOCUMENT
- XML_READER_TYPE_DOCUMENT_TYPE
- XML_READER_TYPE_DOCUMENT_FRAGMENT
- XML_READER_TYPE_NOTATION
- XML_READER_TYPE_WHITESPACE
- XML_READER_TYPE_SIGNIFICANT_WHITESPACE
- XML_READER_TYPE_END_ELEMENT
- XML_READER_TYPE_END_ENTITY
- XML_READER_TYPE_XML_DECLARATION
- )],
- states =>
- [qw(
- XML_READER_NONE
- XML_READER_START
- XML_READER_ELEMENT
- XML_READER_END
- XML_READER_EMPTY
- XML_READER_BACKTRACK
- XML_READER_DONE
- XML_READER_ERROR
- )]
-);
-@EXPORT = (@{$EXPORT_TAGS{types}},@{$EXPORT_TAGS{states}});
-@EXPORT_OK = @EXPORT;
-$EXPORT_TAGS{all}=\@EXPORT_OK;
-}
-
-{
- my %flags = (
- recover => 1, # recover on errors
- expand_entities => 2, # substitute entities
- load_ext_dtd => 4, # load the external subset
- complete_attributes => 8, # default DTD attributes
- validation => 16, # validate with the DTD
- suppress_errors => 32, # suppress error reports
- suppress_warnings => 64, # suppress warning reports
- pedantic_parser => 128, # pedantic error reporting
- no_blanks => 256, # remove blank nodes
- expand_xinclude => 1024, # Implement XInclude substitition
- xinclude => 1024, # ... alias
- no_network => 2048, # Forbid network access
- clean_namespaces => 8192, # remove redundant namespaces declarations
- no_cdata => 16384, # merge CDATA as text nodes
- no_xinclude_nodes => 32768, # do not generate XINCLUDE START/END nodes
- );
- sub _parser_options {
- my ($opts) = @_;
-
- # currently dictionaries break XML::LibXML memory management
- my $no_dict = 4096;
- my $flags = $no_dict; # safety precaution
-
- my ($key, $value);
- while (($key,$value) = each %$opts) {
- my $f = $flags{ $key };
- if (defined $f) {
- if ($value) {
- $flags |= $f
- } else {
- $flags &= ~$f;
- }
- }
- }
- return $flags;
- }
- my %props = (
- load_ext_dtd => 1, # load the external subset
- complete_attributes => 2, # default DTD attributes
- validation => 3, # validate with the DTD
- expand_entities => 4, # substitute entities
- );
- sub getParserProp {
- my ($self, $name) = @_;
- my $prop = $props{$name};
- return undef unless defined $prop;
- return $self->_getParserProp($prop);
- }
- sub setParserProp {
- my $self = shift;
- my %args = map { ref($_) eq 'HASH' ? (%$_) : $_ } @_;
- my ($key, $value);
- while (($key,$value) = each %args) {
- my $prop = $props{ $key };
- $self->_setParserProp($prop,$value);
- }
- return;
- }
-
- my (%string_pool,%rng_pool,%xsd_pool); # used to preserve data passed to the reader
- sub new {
- my ($class) = shift;
- my %args = map { ref($_) eq 'HASH' ? (%$_) : $_ } @_;
- my $encoding = $args{encoding};
- my $URI = $args{URI};
- my $options = _parser_options(\%args);
-
- my $self = undef;
- if ( defined $args{location} ) {
- $self = $class->_newForFile( $args{location}, $encoding, $options );
- }
- elsif ( defined $args{string} ) {
- $self = $class->_newForString( $args{string}, $URI, $encoding, $options );
- $string_pool{$self} = \$args{string};
- }
- elsif ( defined $args{IO} ) {
- $self = $class->_newForIO( $args{IO}, $URI, $encoding, $options );
- }
- elsif ( defined $args{DOM} ) {
- croak("DOM must be a XML::LibXML::Document node")
- unless UNIVERSAL::isa($args{DOM}, 'XML::LibXML::Document');
- $self = $class->_newForDOM( $args{DOM} );
- }
- elsif ( defined $args{FD} ) {
- my $fd = fileno($args{FD});
- $self = $class->_newForFd( $fd, $URI, $encoding, $options );
- }
- else {
- croak("XML::LibXML::Reader->new: specify location, string, IO, DOM, or FD");
- }
- if ($args{RelaxNG}) {
- if (ref($args{RelaxNG})) {
- $rng_pool{$self} = \$args{RelaxNG};
- $self->_setRelaxNG($args{RelaxNG});
- } else {
- $self->_setRelaxNGFile($args{RelaxNG});
- }
- }
- if ($args{Schema}) {
- if (ref($args{Schema})) {
- $xsd_pool{$self} = \$args{Schema};
- $self->_setXSD($args{Schema});
- } else {
- $self->_setXSDFile($args{Schema});
- }
- }
- return $self;
- }
- sub DESTROY {
- my $self = shift;
- delete $string_pool{$self};
- delete $rng_pool{$self};
- delete $xsd_pool{$self};
- $self->_DESTROY;
- }
-}
-sub close {
- my ($reader) = @_;
- # _close return -1 on failure, 0 on success
- # perl close returns 0 on failure, 1 on success
- return $reader->_close == 0 ? 1 : 0;
-}
-
-sub preservePattern {
- my $reader=shift;
- my ($pattern,$ns_map)=@_;
- if (ref($ns_map) eq 'HASH') {
- # translate prefix=>URL hash to a (URL,prefix) list
- $reader->_preservePattern($pattern,[reverse %$ns_map]);
- } else {
- $reader->_preservePattern(@_);
- }
-}
-
-1;
-__END__
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/Reader.pod b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/Reader.pod
deleted file mode 100644
index 9e8ab26550d..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/Reader.pod
+++ /dev/null
@@ -1,716 +0,0 @@
-=head1 NAME
-
-XML::LibXML::Reader - XML::LibXML::Reader - interface to libxml2 pull parser
-
-=head1 SYNOPSIS
-
-
-
- use XML::LibXML::Reader;
-
-
-
- $reader = new XML::LibXML::Reader(location => "file.xml")
- or die "cannot read file.xml\n";
- while ($reader->read) {
- processNode($reader);
- }
-
-
-
- sub processNode {
- $reader = shift;
- printf "%d %d %s %d\n", ($reader->depth,
- $reader->nodeType,
- $reader->name,
- $reader->isEmptyElement);
- }
-
-or
-
-
-
- $reader = new XML::LibXML::Reader(location => "file.xml")
- or die "cannot read file.xml\n";
- $reader->preservePattern('//table/tr');
- $reader->finish;
- print $reader->document->toString(1);
-
-
-=head1 DESCRIPTION
-
-This is a perl interface to libxml2's pull-parser implementation xmlTextReader I<<<<<< http://xmlsoft.org/html/libxml-xmlreader.html >>>>>>. This feature requires at least libxml2-2.6.21. Pull-parser (StAX in Java,
-XmlReader in C#) use an iterator approach to parse a xml-file. They are easier
-to program than event-based parser (SAX) and much more lightweight than
-tree-based parser (DOM), which load the complete tree into memory.
-
-The Reader acts as a cursor going forward on the document stream and stopping
-at each node in the way. At every point DOM-like methods of the Reader object
-allow to examine the current node (name, namespace, attributes, etc.)
-
-The user's code keeps control of the progress and simply calls the C<<<<<< read() >>>>>> function repeatedly to progress to the next node in the document order. Other
-functions provide means for skipping complete sub-trees, or nodes until a
-specific element, etc.
-
-At every time, only a very limited portion of the document is kept in the
-memory, which makes the API more memory-efficient than using DOM. However, it
-is also possible to mix Reader with DOM. At every point the user may copy the
-current node (optionally expanded into a complete sub-tree) from the processed
-document to another DOM tree, or to instruct the Reader to collect sub-document
-in form of a DOM tree consisting of selected nodes.
-
-Reader API also supports namespaces, xml:base, entity handling, and DTD
-validation. Schema and RelaxNG validation support will probably be added in
-some later revision of the Perl interface.
-
-The naming of methods compared to libxml2 and C# XmlTextReader has been changed
-slightly to match the conventions of XML::LibXML. Some functions have been
-changed or added with respect to the C interface.
-
-
-=head1 CONSTRUCTOR
-
-Depending on the XML source, the Reader object can be created with either of:
-
-
-
- my $reader = XML::LibXML::Reader->new( location => "file.xml", ... );
- my $reader = XML::LibXML::Reader->new( string => $xml_string, ... );
- my $reader = XML::LibXML::Reader->new( IO => $file_handle, ... );
- my $reader = XML::LibXML::Reader->new( DOM => $dom, ... );
-
-where ... are (optional) reader options described below in Parser options. The
-constructor recognizes the following XML sources:
-
-
-=head2 Source specification
-
-=over 4
-
-=item B<location>
-
-Read XML from a local file or URL.
-
-
-=item B<string>
-
-Read XML from a string.
-
-
-=item B<IO>
-
-Read XML a Perl IO filehandle.
-
-
-=item B<FD>
-
-Read XML from a file descriptor (bypasses Perl I/O layer, only applicable to
-filehandles for regular files or pipes). Possibly faster than IO.
-
-
-=item B<DOM>
-
-Use reader API to walk through a pre-parsed L<<<<<< XML::LibXML DOM Document Class|XML::LibXML DOM Document Class >>>>>>.
-
-
-
-=back
-
-
-=head2 Parsing options
-
-=over 4
-
-=item B<URI>
-
-can be used to provide baseURI when parsing strings or filehandles.
-
-
-=item B<encoding>
-
-override document encoding.
-
-
-=item B<RelaxNG>
-
-can be used to pass either a L<<<<<< RelaxNG Schema Validation|RelaxNG Schema Validation >>>>>> object or a filename or URL of a RelaxNG schema to the constructor. The schema
-is then used to validate the document as it is processed.
-
-
-=item B<Schema>
-
-can be used to pass either a L<<<<<< XML Schema Validation|XML Schema Validation >>>>>> object or a filename or URL of a W3C XSD schema to the constructor. The schema
-is then used to validate the document as it is processed.
-
-
-=item B<recover>
-
-recover on errors (0 or 1)
-
-
-=item B<expand_entities>
-
-substitute entities (0 or 1)
-
-
-=item B<load_ext_dtd>
-
-load the external subset (0 or 1)
-
-
-=item B<complete_attributes>
-
-default DTD attributes (0 or 1)
-
-
-=item B<validation>
-
-validate with the DTD (0 or 1)
-
-
-=item B<suppress_errors>
-
-suppress error reports (0 or 1)
-
-
-=item B<suppress_warnings>
-
-suppress warning reports (0 or 1)
-
-
-=item B<pedantic_parser>
-
-pedantic error reporting (0 or 1)
-
-
-=item B<no_blanks>
-
-remove blank nodes (0 or 1)
-
-
-=item B<expand_xinclude>
-
-Implement XInclude substitution (0 or 1)
-
-
-=item B<no_network>
-
-Forbid network access (0 or 1)
-
-
-=item B<clean_namespaces>
-
-remove redundant namespaces declarations (0 or 1)
-
-
-=item B<no_cdata>
-
-merge CDATA as text nodes (0 or 1)
-
-
-=item B<no_xinclude_nodes>
-
-do not generate XINCLUDE START/END nodes (0 or 1)
-
-
-
-=back
-
-
-=head1 METHODS CONTROLLING PARSING PROGRESS
-
-=over 4
-
-=item B<read ()>
-
-Moves the position to the next node in the stream, exposing its properties.
-
-Returns 1 if the node was read successfully, 0 if there is no more nodes to
-read, or -1 in case of error
-
-
-=item B<readAttributeValue ()>
-
-Parses an attribute value into one or more Text and EntityReference nodes.
-
-Returns 1 in case of success, 0 if the reader was not positioned on an
-attribute node or all the attribute values have been read, or -1 in case of
-error.
-
-
-=item B<readState ()>
-
-Gets the read state of the reader. Returns the state value, or -1 in case of
-error. The module exports constants for the Reader states, see STATES below.
-
-
-=item B<depth ()>
-
-The depth of the node in the tree, starts at 0 for the root node.
-
-
-=item B<next ()>
-
-Skip to the node following the current one in the document order while avoiding
-the sub-tree if any. Returns 1 if the node was read successfully, 0 if there is
-no more nodes to read, or -1 in case of error.
-
-
-=item B<nextElement (localname?,nsURI?)>
-
-Skip nodes following the current one in the document order until a specific
-element is reached. The element's name must be equal to a given localname if
-defined, and its namespace must equal to a given nsURI if defined. Either of
-the arguments can be undefined (or omitted, in case of the latter or both).
-
-Returns 1 if the element was found, 0 if there is no more nodes to read, or -1
-in case of error.
-
-
-=item B<skipSiblings ()>
-
-Skip all nodes on the same or lower level until the first node on a higher
-level is reached. In particular, if the current node occurs in an element, the
-reader stops at the end tag of the parent element, otherwise it stops at a node
-immediately following the parent node.
-
-Returns 1 if successful, 0 if end of the document is reached, or -1 in case of
-error.
-
-
-=item B<nextSibling ()>
-
-It skips to the node following the current one in the document order while
-avoiding the sub-tree if any.
-
-Returns 1 if the node was read successfully, 0 if there is no more nodes to
-read, or -1 in case of error
-
-
-=item B<nextSiblingElement (name?,nsURI?)>
-
-Like nextElement but only processes sibling elements of the current node
-(moving forward using C<<<<<< nextSibling () >>>>>> rather than C<<<<<< read () >>>>>>, internally).
-
-Returns 1 if the element was found, 0 if there is no more sibling nodes, or -1
-in case of error.
-
-
-=item B<finish ()>
-
-Skip all remaining nodes in the document, reaching end of the document.
-
-Returns 1 if successful, 0 in case of error.
-
-
-=item B<close ()>
-
-This method releases any resources allocated by the current instance and closes
-any underlying input. It returns 0 on failure and 1 on success. This method is
-automatically called by the destructor when the reader is forgotten, therefore
-you do not have to call it directly.
-
-
-
-=back
-
-
-=head1 METHODS EXTRACTING INFORMATION
-
-=over 4
-
-=item B<name ()>
-
-Returns the qualified name of the current node, equal to (Prefix:)LocalName.
-
-
-=item B<nodeType ()>
-
-Returns the type of the current node. See NODE TYPES below.
-
-
-=item B<localName ()>
-
-Returns the local name of the node.
-
-
-=item B<prefix ()>
-
-Returns the prefix of the namespace associated with the node.
-
-
-=item B<namespaceURI ()>
-
-Returns the URI defining the namespace associated with the node.
-
-
-=item B<isEmptyElement ()>
-
-Check if the current node is empty, this is a bit bizarre in the sense that
-<a/> will be considered empty while <a></a> will not.
-
-
-=item B<hasValue ()>
-
-Returns true if the node can have a text value.
-
-
-=item B<value ()>
-
-Provides the text value of the node if present or undef if not available.
-
-
-=item B<readInnerXml ()>
-
-Reads the contents of the current node, including child nodes and markup.
-Returns a string containing the XML of the node's content, or undef if the
-current node is neither an element nor attribute, or has no child nodes.
-
-
-=item B<readOuterXml ()>
-
-Reads the contents of the current node, including child nodes and markup.
-
-Returns a string containing the XML of the node including its content, or undef
-if the current node is neither an element nor attribute.
-
-
-
-=back
-
-
-=head1 METHODS EXTRACTING DOM NODES
-
-=over 4
-
-=item B<document ()>
-
-Provides access to the document tree built by the reader. This function can be
-used to collect the preserved nodes (see C<<<<<< preserveNode() >>>>>> and preservePattern).
-
-CAUTION: Never use this function to modify the tree unless reading of the whole
-document is completed!
-
-
-=item B<copyCurrentNode (deep)>
-
-This function is similar a DOM function C<<<<<< copyNode() >>>>>>. It returns a copy of the currently processed node as a corresponding DOM
-object. Use deep = 1 to obtain the full sub-tree.
-
-
-=item B<preserveNode ()>
-
-This tells the XML Reader to preserve the current node in the document tree. A
-document tree consisting of the preserved nodes and their content can be
-obtained using the method C<<<<<< document() >>>>>> once parsing is finished.
-
-Returns the node or NULL in case of error.
-
-
-=item B<preservePattern (pattern,\%ns_map)>
-
-This tells the XML Reader to preserve all nodes matched by the pattern (which
-is a streaming XPath subset). A document tree consisting of the preserved nodes
-and their content can be obtained using the method C<<<<<< document() >>>>>> once parsing is finished.
-
-An optional second argument can be used to provide a HASH reference mapping
-prefixes used by the XPath to namespace URIs.
-
-The XPath subset available with this function is described at
-
-
-
- http://www.w3.org/TR/xmlschema-1/#Selector
-
-and matches the production
-
-
-
- Path ::= ('.//')? ( Step '/' )* ( Step | '@' NameTest )
-
-Returns a positive number in case of success and -1 in case of error
-
-
-
-=back
-
-
-=head1 METHODS PROCESSING ATTRIBUTES
-
-=over 4
-
-=item B<attributeCount ()>
-
-Provides the number of attributes of the current node.
-
-
-=item B<hasAttributes ()>
-
-Whether the node has attributes.
-
-
-=item B<getAttribute (name)>
-
-Provides the value of the attribute with the specified qualified name.
-
-Returns a string containing the value of the specified attribute, or undef in
-case of error.
-
-
-=item B<getAttributeNs (localName, namespaceURI)>
-
-Provides the value of the specified attribute.
-
-Returns a string containing the value of the specified attribute, or undef in
-case of error.
-
-
-=item B<getAttributeNo (no)>
-
-Provides the value of the attribute with the specified index relative to the
-containing element.
-
-Returns a string containing the value of the specified attribute, or undef in
-case of error.
-
-
-=item B<isDefault ()>
-
-Returns true if the current attribute node was generated from the default value
-defined in the DTD.
-
-
-=item B<moveToAttribute (name)>
-
-Moves the position to the attribute with the specified local name and namespace
-URI.
-
-Returns 1 in case of success, -1 in case of error, 0 if not found
-
-
-=item B<moveToAttributeNo (no)>
-
-Moves the position to the attribute with the specified index relative to the
-containing element.
-
-Returns 1 in case of success, -1 in case of error, 0 if not found
-
-
-=item B<moveToAttributeNs (localName,namespaceURI)>
-
-Moves the position to the attribute with the specified local name and namespace
-URI.
-
-Returns 1 in case of success, -1 in case of error, 0 if not found
-
-
-=item B<moveToFirstAttribute ()>
-
-Moves the position to the first attribute associated with the current node.
-
-Returns 1 in case of success, -1 in case of error, 0 if not found
-
-
-=item B<moveToNextAttribute ()>
-
-Moves the position to the next attribute associated with the current node.
-
-Returns 1 in case of success, -1 in case of error, 0 if not found
-
-
-=item B<moveToElement ()>
-
-Moves the position to the node that contains the current attribute node.
-
-Returns 1 in case of success, -1 in case of error, 0 if not moved
-
-
-=item B<isNamespaceDecl ()>
-
-Determine whether the current node is a namespace declaration rather than a
-regular attribute.
-
-Returns 1 if the current node is a namespace declaration, 0 if it is a regular
-attribute or other type of node, or -1 in case of error.
-
-
-
-=back
-
-
-=head1 OTHER METHODS
-
-=over 4
-
-=item B<lookupNamespace (prefix)>
-
-Resolves a namespace prefix in the scope of the current element.
-
-Returns a string containing the namespace URI to which the prefix maps or undef
-in case of error.
-
-
-=item B<encoding ()>
-
-Returns a string containing the encoding of the document or undef in case of
-error.
-
-
-=item B<standalone ()>
-
-Determine the standalone status of the document being read. Returns 1 if the
-document was declared to be standalone, 0 if it was declared to be not
-standalone, or -1 if the document did not specify its standalone status or in
-case of error.
-
-
-=item B<xmlVersion ()>
-
-Determine the XML version of the document being read. Returns a string
-containing the XML version of the document or undef in case of error.
-
-
-=item B<baseURI ()>
-
-The base URI of the node. See the XML Base W3C specification.
-
-
-=item B<isValid ()>
-
-Retrieve the validity status from the parser.
-
-Returns 1 if valid, 0 if no, and -1 in case of error.
-
-
-=item B<xmlLang ()>
-
-The xml:lang scope within which the node resides.
-
-
-=item B<lineNumber ()>
-
-Provide the line number of the current parsing point.
-
-
-=item B<columnNumber ()>
-
-Provide the column number of the current parsing point.
-
-
-=item B<byteConsumed ()>
-
-This function provides the current index of the parser relative to the start of
-the current entity. This function is computed in bytes from the beginning
-starting at zero and finishing at the size in bytes of the file if parsing a
-file. The function is of constant cost if the input is UTF-8 but can be costly
-if run on non-UTF-8 input.
-
-
-=item B<setParserProp (prop => value, ...)>
-
-Change the parser processing behaviour by changing some of its internal
-properties. The following properties are available with this function:
-``load_ext_dtd'', ``complete_attributes'', ``validation'', ``expand_entities''.
-
-Since some of the properties can only be changed before any read has been done,
-it is best to set the parsing properties at the constructor.
-
-Returns 0 if the call was successful, or -1 in case of error
-
-
-=item B<getParserProp (prop)>
-
-Get value of an parser internal property. The following property names can be
-used: ``load_ext_dtd'', ``complete_attributes'', ``validation'',
-``expand_entities''.
-
-Returns the value, usually 0 or 1, or -1 in case of error.
-
-
-
-=back
-
-
-=head1 DESTRUCTION
-
-XML::LibXML takes care of the reader object destruction when the last reference
-to the reader object goes out of scope. The document tree is preserved, though,
-if either of $reader->document or $reader->preserveNode was used and references
-to the document tree exist.
-
-
-=head1 NODE TYPES
-
-The reader interface provides the following constants for node types (the
-constant symbols are exported by default or if tag C<<<<<< :types >>>>>> is used).
-
-
-
- XML_READER_TYPE_NONE => 0
- XML_READER_TYPE_ELEMENT => 1
- XML_READER_TYPE_ATTRIBUTE => 2
- XML_READER_TYPE_TEXT => 3
- XML_READER_TYPE_CDATA => 4
- XML_READER_TYPE_ENTITY_REFERENCE => 5
- XML_READER_TYPE_ENTITY => 6
- XML_READER_TYPE_PROCESSING_INSTRUCTION => 7
- XML_READER_TYPE_COMMENT => 8
- XML_READER_TYPE_DOCUMENT => 9
- XML_READER_TYPE_DOCUMENT_TYPE => 10
- XML_READER_TYPE_DOCUMENT_FRAGMENT => 11
- XML_READER_TYPE_NOTATION => 12
- XML_READER_TYPE_WHITESPACE => 13
- XML_READER_TYPE_SIGNIFICANT_WHITESPACE => 14
- XML_READER_TYPE_END_ELEMENT => 15
- XML_READER_TYPE_END_ENTITY => 16
- XML_READER_TYPE_XML_DECLARATION => 17
-
-
-=head1 STATES
-
-The following constants represent the values returned by C<<<<<< readState() >>>>>>. They are exported by default, or if tag C<<<<<< :states >>>>>> is used:
-
-
-
- XML_READER_NONE => -1
- XML_READER_START => 0
- XML_READER_ELEMENT => 1
- XML_READER_END => 2
- XML_READER_EMPTY => 3
- XML_READER_BACKTRACK => 4
- XML_READER_DONE => 5
- XML_READER_ERROR => 6
-
-
-=head1 VERSION
-
-0.02
-
-
-=head1 AUTHORS
-
-Heiko Klein, <H.Klein@gmx.net<gt> and Petr Pajas, <pajas@matfyz.cz<gt>
-
-
-=head1 SEE ALSO
-
-http://xmlsoft.org/html/libxml-xmlreader.html
-
-http://dotgnu.org/pnetlib-doc/System/Xml/XmlTextReader.html
-
-=head1 AUTHORS
-
-Matt Sergeant,
-Christian Glahn,
-Petr Pajas
-
-
-=head1 VERSION
-
-1.66
-
-=head1 COPYRIGHT
-
-2001-2007, AxKit.com Ltd; 2002-2006 Christian Glahn; 2006-2008 Petr Pajas, All rights reserved.
-
-=cut
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/RelaxNG.pod b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/RelaxNG.pod
deleted file mode 100644
index a233ead4742..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/RelaxNG.pod
+++ /dev/null
@@ -1,77 +0,0 @@
-=head1 NAME
-
-XML::LibXML::RelaxNG - RelaxNG Schema Validation
-
-=head1 SYNOPSIS
-
-
-
- use XML::LibXML;
- $doc = XML::LibXML->new->parse_file($url);
-
- $rngschema = XML::LibXML::RelaxNG->new( location => $filename_or_url );
- $rngschema = XML::LibXML::RelaxNG->new( string => $xmlschemastring );
- $rngschema = XML::LibXML::RelaxNG->new( DOM => $doc );
- eval { $rngschema->validate( $doc ); };
-
-=head1 DESCRIPTION
-
-The XML::LibXML::RelaxNG class is a tiny frontend to libxml2's RelaxNG
-implementation. Currently it supports only schema parsing and document
-validation.
-
-
-=head1 METHODS
-
-=over 4
-
-=item B<new>
-
- $rngschema = XML::LibXML::RelaxNG->new( location => $filename_or_url );
- $rngschema = XML::LibXML::RelaxNG->new( string => $xmlschemastring );
- $rngschema = XML::LibXML::RelaxNG->new( DOM => $doc );
-
-The constructor of XML::LibXML::RelaxNG may get called with either one of three
-parameters. The parameter tells the class from which source it should generate
-a validation schema. It is important, that each schema only have a single
-source.
-
-The location parameter allows to parse a schema from the filesystem or a URL.
-
-The string parameter will parse the schema from the given XML string.
-
-The DOM parameter allows to parse the schema from a pre-parsed L<<<<<< XML::LibXML DOM Document Class|XML::LibXML DOM Document Class >>>>>>.
-
-Note that the constructor will die() if the schema does not meed the
-constraints of the RelaxNG specification.
-
-
-=item B<validate>
-
- eval { $rngschema->validate( $doc ); };
-
-This function allows to validate a (parsed) document against the given RelaxNG
-schema. The argument of this function should be a XML::LibXML::Document object.
-If this function succeeds, it will return 0, otherwise it will die() and report
-the errors found. Because of this validate() should be always evaluated.
-
-
-
-=back
-
-=head1 AUTHORS
-
-Matt Sergeant,
-Christian Glahn,
-Petr Pajas
-
-
-=head1 VERSION
-
-1.66
-
-=head1 COPYRIGHT
-
-2001-2007, AxKit.com Ltd; 2002-2006 Christian Glahn; 2006-2008 Petr Pajas, All rights reserved.
-
-=cut
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/SAX.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/SAX.pm
deleted file mode 100644
index de8821e83bc..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/SAX.pm
+++ /dev/null
@@ -1,81 +0,0 @@
-# $Id: SAX.pm 709 2008-01-29 21:01:32Z pajas $
-# Copyright (c) 2001-2002, AxKit.com Ltd. All rights reserved.
-package XML::LibXML::SAX;
-
-use strict;
-use vars qw($VERSION @ISA);
-
-$VERSION = "1.66"; # VERSION TEMPLATE: DO NOT CHANGE
-
-use XML::LibXML;
-use XML::SAX::Base;
-
-use base qw(XML::SAX::Base);
-
-use Carp;
-use IO::File;
-
-sub _parse_characterstream {
- my ( $self, $fh ) = @_;
- # this my catch the xml decl, so the parser won't get confused about
- # a possibly wrong encoding.
- croak( "not implemented yet" );
-}
-
-sub _parse_bytestream {
- my ( $self, $fh ) = @_;
- $self->{ParserOptions}{LibParser} = XML::LibXML->new;
- $self->{ParserOptions}{ParseFunc} = \&XML::LibXML::parse_fh;
- $self->{ParserOptions}{ParseFuncParam} = $fh;
- return $self->_parse;
-}
-
-sub _parse_string {
- my ( $self, $string ) = @_;
-# $self->{ParserOptions}{LibParser} = XML::LibXML->new;
- $self->{ParserOptions}{LibParser} = XML::LibXML->new() unless defined $self->{ParserOptions}{LibParser};
- $self->{ParserOptions}{ParseFunc} = \&XML::LibXML::parse_string;
- $self->{ParserOptions}{ParseFuncParam} = $string;
- return $self->_parse;
-}
-
-sub _parse_systemid {
- my $self = shift;
- $self->{ParserOptions}{LibParser} = XML::LibXML->new;
- $self->{ParserOptions}{ParseFunc} = \&XML::LibXML::parse_file;
- $self->{ParserOptions}{ParseFuncParam} = shift;
- return $self->_parse;
-}
-
-sub parse_chunk {
- my ( $self, $chunk ) = @_;
- $self->{ParserOptions}{LibParser} = XML::LibXML->new;
- $self->{ParserOptions}{ParseFunc} = \&XML::LibXML::parse_xml_chunk;
- $self->{ParserOptions}{ParseFuncParam} = $chunk;
- return $self->_parse;
-}
-
-sub _parse {
- my $self = shift;
- my $args = bless $self->{ParserOptions}, ref($self);
-
- $args->{LibParser}->set_handler( $self );
- eval {
- $args->{ParseFunc}->($args->{LibParser}, $args->{ParseFuncParam});
- };
-
- if ( $args->{LibParser}->{SAX}->{State} == 1 ) {
- croak( "SAX Exception not implemented, yet; Data ended before document ended\n" );
- }
-
- # break a possible circular reference
- $args->{LibParser}->set_handler( undef );
- if ( $@ ) {
- croak $@;
- }
- return $self->end_document({});
-}
-
-
-1;
-
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/SAX.pod b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/SAX.pod
deleted file mode 100644
index e9462136dea..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/SAX.pod
+++ /dev/null
@@ -1,46 +0,0 @@
-=head1 NAME
-
-XML::LibXML::SAX - XML::LibXML direct SAX parser
-
-
-=head1 DESCRIPTION
-
-XML::LibXML provides an interface to libxml2 direct SAX interface. Through this
-interface it is possible to generate SAX events directly while parsing a
-document. While using the SAX parser XML::LibXML will not create a DOM Document
-tree.
-
-Such an interface is useful if very large XML documents have to be processed
-and no DOM functions are required. By using this interface it is possible to
-read data stored within a XML document directly into the application data
-structures without loading the document into memory.
-
-The SAX interface of XML::LibXML is based on the famous XML::SAX interface. It
-uses the generic interface as provided by XML::SAX::Base.
-
-Additionally to the generic functions, which are only able to process entire
-documents, XML::LibXML::SAX provides I<<<<<< parse_chunk() >>>>>>. This method generates SAX events from well balanced data such as is often
-provided by databases.
-
-I<<<<<< NOTE: >>>>>> At the moment XML::LibXML provides only an incomplete interface to libxml2's
-native SAX implementation. The current implementation is not tested in
-production environment. It may causes significant memory problems or shows
-wrong behaviour. If you run into specific problems using this part of
-XML::LibXML, let me know.
-
-=head1 AUTHORS
-
-Matt Sergeant,
-Christian Glahn,
-Petr Pajas
-
-
-=head1 VERSION
-
-1.66
-
-=head1 COPYRIGHT
-
-2001-2007, AxKit.com Ltd; 2002-2006 Christian Glahn; 2006-2008 Petr Pajas, All rights reserved.
-
-=cut
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/SAX/Builder.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/SAX/Builder.pm
deleted file mode 100644
index 0c1691dc876..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/SAX/Builder.pm
+++ /dev/null
@@ -1,322 +0,0 @@
-# $Id: Builder.pm 709 2008-01-29 21:01:32Z pajas $
-
-package XML::LibXML::SAX::Builder;
-
-use XML::LibXML;
-use XML::NamespaceSupport;
-
-use vars qw ($VERSION);
-
-$VERSION = "1.66"; # VERSION TEMPLATE: DO NOT CHANGE
-
-sub new {
- my $class = shift;
- return bless {@_}, $class;
-}
-
-sub result { $_[0]->{LAST_DOM}; }
-
-sub done {
- my ($self) = @_;
- my $dom = $self->{DOM};
- $dom = $self->{Parent} unless defined $dom; # this is for parsing document chunks
-
- delete $self->{NamespaceStack};
- delete $self->{Parent};
- delete $self->{DOM};
-
- $self->{LAST_DOM} = $dom;
-
- return $dom;
-}
-
-sub set_document_locator {
-}
-
-sub start_dtd {
- my ($self, $dtd) = @_;
- if (defined $dtd->{Name} and
- (defined $dtd->{SystemID} or defined $dtd->{PublicID})) {
- $self->{DOM}->createExternalSubset($dtd->{Name},$dtd->{PublicID},$dtd->{SystemID});
- }
-}
-
-sub end_dtd {
-}
-
-sub start_document {
- my ($self, $doc) = @_;
-
- $self->{DOM} = XML::LibXML::Document->createDocument();
-
- if ( defined $self->{Encoding} ) {
- $self->xml_decl({Version => ($self->{Version} || '1.0') , Encoding => $self->{Encoding}});
- }
-
- $self->{NamespaceStack} = XML::NamespaceSupport->new;
- $self->{NamespaceStack}->push_context;
- $self->{Parent} = undef;
- return ();
-}
-
-sub xml_decl {
- my $self = shift;
- my $decl = shift;
-
- if ( defined $decl->{Version} ) {
- $self->{DOM}->setVersion( $decl->{Version} );
- }
- if ( defined $decl->{Encoding} ) {
- $self->{DOM}->setEncoding( $decl->{Encoding} );
- }
- return ();
-}
-
-sub end_document {
- my ($self, $doc) = @_;
- my $d = $self->done();
- return $d;
-}
-
-sub start_prefix_mapping {
- my $self = shift;
- my $ns = shift;
-
- unless ( defined $self->{DOM} or defined $self->{Parent} ) {
- $self->{Parent} = XML::LibXML::DocumentFragment->new();
- $self->{NamespaceStack} = XML::NamespaceSupport->new;
- $self->{NamespaceStack}->push_context;
- }
-
- $self->{USENAMESPACESTACK} = 1;
-
- $self->{NamespaceStack}->declare_prefix( $ns->{Prefix}, $ns->{NamespaceURI} );
- return ();
-}
-
-
-sub end_prefix_mapping {
- my $self = shift;
- my $ns = shift;
- $self->{NamespaceStack}->undeclare_prefix( $ns->{Prefix} );
- return ();
-}
-
-
-sub start_element {
- my ($self, $el) = @_;
- my $node;
-
- unless ( defined $self->{DOM} or defined $self->{Parent} ) {
- $self->{Parent} = XML::LibXML::DocumentFragment->new();
- $self->{NamespaceStack} = XML::NamespaceSupport->new;
- $self->{NamespaceStack}->push_context;
- }
-
- if ( defined $self->{Parent} ) {
- $el->{NamespaceURI} ||= "";
- $node = $self->{Parent}->addNewChild( $el->{NamespaceURI},
- $el->{Name} );
- }
- else {
- if ($el->{NamespaceURI}) {
- if ( defined $self->{DOM} ) {
- $node = $self->{DOM}->createRawElementNS($el->{NamespaceURI},
- $el->{Name});
- }
- else {
- $node = XML::LibXML::Element->new( $el->{Name} );
- $node->setNamespace( $el->{NamespaceURI},
- $el->{Prefix} , 1 );
- }
- }
- else {
- if ( defined $self->{DOM} ) {
- $node = $self->{DOM}->createRawElement($el->{Name});
- }
- else {
- $node = XML::LibXML::Element->new( $el->{Name} );
- }
- }
-
- $self->{DOM}->setDocumentElement($node);
- }
-
- # build namespaces
- my $skip_ns= 0;
- foreach my $p ( $self->{NamespaceStack}->get_declared_prefixes() ) {
- $skip_ns= 1;
- my $uri = $self->{NamespaceStack}->get_uri($p);
- my $nodeflag = 0;
- if ( defined $uri
- and defined $el->{NamespaceURI}
- and $uri eq $el->{NamespaceURI} ) {
- # $nodeflag = 1;
- next;
- }
- $node->setNamespace($uri, $p, 0 );
- }
-
- $self->{Parent} = $node;
-
- $self->{NamespaceStack}->push_context;
-
- # do attributes
- foreach my $key (keys %{$el->{Attributes}}) {
- my $attr = $el->{Attributes}->{$key};
- if (ref($attr)) {
- # catch broken name/value pairs
- next unless $attr->{Name} ;
- next if $self->{USENAMESPACESTACK}
- and ( $attr->{Name} eq "xmlns"
- or ( defined $attr->{Prefix}
- and $attr->{Prefix} eq "xmlns" ) );
-
-
- if ( defined $attr->{Prefix}
- and $attr->{Prefix} eq "xmlns" and $skip_ns == 0 ) {
- # ok, the generator does not set namespaces correctly!
- my $uri = $attr->{Value};
- $node->setNamespace($uri,
- $attr->{Localname},
- $uri eq $el->{NamespaceURI} ? 1 : 0 );
- }
- else {
- $node->setAttributeNS($attr->{NamespaceURI} || "",
- $attr->{Name}, $attr->{Value});
- }
- }
- else {
- $node->setAttribute($key => $attr);
- }
- }
- return ();
-}
-
-sub end_element {
- my ($self, $el) = @_;
- return unless $self->{Parent};
-
- $self->{NamespaceStack}->pop_context;
- $self->{Parent} = $self->{Parent}->parentNode();
- return ();
-}
-
-sub start_cdata {
- my $self = shift;
- $self->{IN_CDATA} = 1;
- return ();
-}
-
-sub end_cdata {
- my $self = shift;
- $self->{IN_CDATA} = 0;
- return ();
-}
-
-sub characters {
- my ($self, $chars) = @_;
- if ( not defined $self->{DOM} and not defined $self->{Parent} ) {
- $self->{Parent} = XML::LibXML::DocumentFragment->new();
- $self->{NamespaceStack} = XML::NamespaceSupport->new;
- $self->{NamespaceStack}->push_context;
- }
- return unless $self->{Parent};
- my $node;
-
- unless ( defined $chars and defined $chars->{Data} ) {
- return;
- }
-
- if ( defined $self->{DOM} ) {
- if ( defined $self->{IN_CDATA} and $self->{IN_CDATA} == 1 ) {
- $node = $self->{DOM}->createCDATASection($chars->{Data});
- }
- else {
- $node = $self->{Parent}->appendText($chars->{Data});
- return;
- }
- }
- elsif ( defined $self->{IN_CDATA} and $self->{IN_CDATA} == 1 ) {
- $node = XML::LibXML::CDATASection->new($chars->{Data});
- }
- else {
- $node = XML::LibXML::Text->new($chars->{Data});
- }
-
- $self->{Parent}->addChild($node);
- return ();
-}
-
-sub comment {
- my ($self, $chars) = @_;
- my $comment;
- if ( not defined $self->{DOM} and not defined $self->{Parent} ) {
- $self->{Parent} = XML::LibXML::DocumentFragment->new();
- $self->{NamespaceStack} = XML::NamespaceSupport->new;
- $self->{NamespaceStack}->push_context;
- }
-
- unless ( defined $chars and defined $chars->{Data} ) {
- return;
- }
-
- if ( defined $self->{DOM} ) {
- $comment = $self->{DOM}->createComment( $chars->{Data} );
- }
- else {
- $comment = XML::LibXML::Comment->new( $chars->{Data} );
- }
-
- if ( defined $self->{Parent} ) {
- $self->{Parent}->addChild($comment);
- }
- else {
- $self->{DOM}->addChild($comment);
- }
- return ();
-}
-
-sub processing_instruction {
- my ( $self, $pi ) = @_;
- my $PI;
- return unless defined $self->{DOM};
- $PI = $self->{DOM}->createPI( $pi->{Target}, $pi->{Data} );
-
- if ( defined $self->{Parent} ) {
- $self->{Parent}->addChild( $PI );
- }
- else {
- $self->{DOM}->addChild( $PI );
- }
- return ();
-}
-
-sub warning {
- my $self = shift;
- my $error = shift;
- # fill $@ but do not die seriously
- eval { $error->throw; };
-}
-
-sub error {
- my $self = shift;
- my $error = shift;
- delete $self->{NamespaceStack};
- delete $self->{Parent};
- delete $self->{DOM};
- $error->throw;
-}
-
-sub fatal_error {
- my $self = shift;
- my $error = shift;
- delete $self->{NamespaceStack};
- delete $self->{Parent};
- delete $self->{DOM};
- $error->throw;
-}
-
-1;
-
-__END__
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/SAX/Builder.pod b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/SAX/Builder.pod
deleted file mode 100644
index 18891b4fa68..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/SAX/Builder.pod
+++ /dev/null
@@ -1,47 +0,0 @@
-=head1 NAME
-
-XML::LibXML::SAX::Builder - Building DOM trees from SAX events.
-
-=head1 SYNOPSIS
-
-
-
- use XML::LibXML::SAX::Builder;
- my $builder = XML::LibXML::SAX::Builder->new();
-
- my $gen = XML::Generator::DBI->new(Handler => $builder, dbh => $dbh);
- $gen->execute("SELECT * FROM Users");
-
- my $doc = $builder->result();
-
-
-=head1 DESCRIPTION
-
-This is a SAX handler that generates a DOM tree from SAX events. Usage is as
-above. Input is accepted from any SAX1 or SAX2 event generator.
-
-Building DOM trees from SAX events is quite easy with
-XML::LibXML::SAX::Builder. The class is designed as a SAX2 final handler not as
-a filter!
-
-Since SAX is strictly stream oriented, you should not expect anything to return
-from a generator. Instead you have to ask the builder instance directly to get
-the document built. XML::LibXML::SAX::Builder's result() function holds the
-document generated from the last SAX stream.
-
-=head1 AUTHORS
-
-Matt Sergeant,
-Christian Glahn,
-Petr Pajas
-
-
-=head1 VERSION
-
-1.66
-
-=head1 COPYRIGHT
-
-2001-2007, AxKit.com Ltd; 2002-2006 Christian Glahn; 2006-2008 Petr Pajas, All rights reserved.
-
-=cut
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/SAX/Generator.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/SAX/Generator.pm
deleted file mode 100644
index 2854619cb50..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/SAX/Generator.pm
+++ /dev/null
@@ -1,146 +0,0 @@
-# $Id: Generator.pm 709 2008-01-29 21:01:32Z pajas $
-
-package XML::LibXML::SAX::Generator;
-
-use strict;
-
-use XML::LibXML;
-use vars qw ($VERSION);
-
-$VERSION = "1.66"; # VERSION TEMPLATE: DO NOT CHANGE
-
-warn("This class (", __PACKAGE__, ") is deprecated!");
-
-sub new {
- my $class = shift;
- unshift @_, 'Handler' unless @_ != 1;
- my %p = @_;
- return bless \%p, $class;
-}
-
-sub generate {
- my $self = shift;
- my ($node) = @_;
-
- my $document = { Parent => undef };
- $self->{Handler}->start_document($document);
-
- process_node($self->{Handler}, $node);
-
- $self->{Handler}->end_document($document);
-}
-
-sub process_node {
- my ($handler, $node) = @_;
-
- my $node_type = $node->getType();
- if ($node_type == XML_COMMENT_NODE) {
- $handler->comment( { Data => $node->getData } );
- }
- elsif ($node_type == XML_TEXT_NODE || $node_type == XML_CDATA_SECTION_NODE) {
- # warn($node->getData . "\n");
- $handler->characters( { Data => $node->getData } );
- }
- elsif ($node_type == XML_ELEMENT_NODE) {
- # warn("<" . $node->getName . ">\n");
- process_element($handler, $node);
- # warn("</" . $node->getName . ">\n");
- }
- elsif ($node_type == XML_ENTITY_REF_NODE) {
- foreach my $kid ($node->getChildnodes) {
- # warn("child of entity ref: " . $kid->getType() . " called: " . $kid->getName . "\n");
- process_node($handler, $kid);
- }
- }
- elsif ($node_type == XML_DOCUMENT_NODE) {
- # just get root element. Ignore other cruft.
- foreach my $kid ($node->getChildnodes) {
- if ($kid->getType() == XML_ELEMENT_NODE) {
- process_element($handler, $kid);
- last;
- }
- }
- }
- else {
- warn("unknown node type: $node_type");
- }
-}
-
-sub process_element {
- my ($handler, $element) = @_;
-
- my @attr;
-
- foreach my $attr ($element->getAttributes) {
- push @attr, XML::LibXML::SAX::AttributeNode->new(
- Name => $attr->getName,
- Value => $attr->getData,
- NamespaceURI => $attr->getNamespaceURI,
- Prefix => $attr->getPrefix,
- LocalName => $attr->getLocalName,
- );
- }
-
- my $node = {
- Name => $element->getName,
- Attributes => { map { $_->{Name} => $_ } @attr },
- NamespaceURI => $element->getNamespaceURI,
- Prefix => $element->getPrefix,
- LocalName => $element->getLocalName,
- };
-
- $handler->start_element($node);
-
- foreach my $child ($element->getChildnodes) {
- process_node($handler, $child);
- }
-
- $handler->end_element($node);
-}
-
-package XML::LibXML::SAX::AttributeNode;
-
-use overload '""' => "stringify";
-
-sub new {
- my $class = shift;
- my %p = @_;
- return bless \%p, $class;
-}
-
-sub stringify {
- my $self = shift;
- return $self->{Value};
-}
-
-1;
-
-__END__
-
-=head1 NAME
-
-XML::LibXML::SAX::Generator - Generate SAX events from a LibXML tree
-
-=head1 SYNOPSIS
-
- my $handler = MySAXHandler->new();
- my $generator = XML::LibXML::SAX::Generator->new(Handler => $handler);
- my $dom = XML::LibXML->new->parse_file("foo.xml");
-
- $generator->generate($dom);
-
-=head1 DESCRIPTION
-
-THIS CLASS IS DEPRACED! Use XML::LibXML::SAX::Parser instead!
-
-This helper class allows you to generate SAX events from any XML::LibXML
-node, and all it's sub-nodes. This basically gives you interop from
-XML::LibXML to other modules that may implement SAX.
-
-It uses SAX2 style, but should be compatible with anything SAX1, by use
-of stringification overloading.
-
-There is nothing to really know about, beyond the synopsis above, and
-a general knowledge of how to use SAX, which is beyond the scope here.
-
-=cut
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/SAX/Parser.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/SAX/Parser.pm
deleted file mode 100644
index 40137cb7c95..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/SAX/Parser.pm
+++ /dev/null
@@ -1,254 +0,0 @@
-# $Id: Parser.pm 709 2008-01-29 21:01:32Z pajas $
-
-package XML::LibXML::SAX::Parser;
-
-use strict;
-use vars qw($VERSION @ISA);
-
-use XML::LibXML;
-use XML::LibXML::Common qw(:libxml);
-use XML::SAX::Base;
-use XML::SAX::DocumentLocator;
-
-$VERSION = "1.66"; # VERSION TEMPLATE: DO NOT CHANGE
-@ISA = ('XML::SAX::Base');
-
-sub _parse_characterstream {
- my ($self, $fh, $options) = @_;
- die "parsing a characterstream is not supported at this time";
-}
-
-sub _parse_bytestream {
- my ($self, $fh, $options) = @_;
- my $parser = XML::LibXML->new();
- my $doc = exists($options->{Source}{SystemId}) ? $parser->parse_fh($fh, $options->{Source}{SystemId}) : $parser->parse_fh($fh);
- $self->generate($doc);
-}
-
-sub _parse_string {
- my ($self, $str, $options) = @_;
- my $parser = XML::LibXML->new();
- my $doc = exists($options->{Source}{SystemId}) ? $parser->parse_string($str, $options->{Source}{SystemId}) : $parser->parse_string($str);
- $self->generate($doc);
-}
-
-sub _parse_systemid {
- my ($self, $sysid, $options) = @_;
- my $parser = XML::LibXML->new();
- my $doc = $parser->parse_file($sysid);
- $self->generate($doc);
-}
-
-sub generate {
- my $self = shift;
- my ($node) = @_;
-
- my $doc = $node->ownerDocument();
- {
- # precompute some DocumentLocator values
- my %locator = (
- PublicId => undef,
- SystemId => undef,
- Encoding => undef,
- XMLVersion => undef,
- );
- my $dtd = defined $doc ? $doc->externalSubset() : undef;
- if (defined $dtd) {
- $locator{PublicId} = $dtd->publicId();
- $locator{SystemId} = $dtd->systemId();
- }
- if (defined $doc) {
- $locator{Encoding} = $doc->encoding();
- $locator{XMLVersion} = $doc->version();
- }
- $self->set_document_locator(
- XML::SAX::DocumentLocator->new(
- sub { $locator{PublicId} },
- sub { $locator{SystemId} },
- sub { defined($self->{current_node}) ? $self->{current_node}->line_number() : undef },
- sub { 1 },
- sub { $locator{Encoding} },
- sub { $locator{XMLVersion} },
- ),
- );
- }
-
- if ( $node->nodeType() == XML_DOCUMENT_NODE
- || $node->nodeType == XML_HTML_DOCUMENT_NODE ) {
- $self->start_document({});
- $self->xml_decl({Version => $node->getVersion, Encoding => $node->getEncoding});
- $self->process_node($node);
- $self->end_document({});
- }
-}
-
-sub process_node {
- my ($self, $node) = @_;
-
- local $self->{current_node} = $node;
-
- my $node_type = $node->nodeType();
- if ($node_type == XML_COMMENT_NODE) {
- $self->comment( { Data => $node->getData } );
- }
- elsif ($node_type == XML_TEXT_NODE
- || $node_type == XML_CDATA_SECTION_NODE) {
- # warn($node->getData . "\n");
- $self->characters( { Data => $node->nodeValue } );
- }
- elsif ($node_type == XML_ELEMENT_NODE) {
- # warn("<" . $node->getName . ">\n");
- $self->process_element($node);
- # warn("</" . $node->getName . ">\n");
- }
- elsif ($node_type == XML_ENTITY_REF_NODE) {
- foreach my $kid ($node->childNodes) {
- # warn("child of entity ref: " . $kid->getType() . " called: " . $kid->getName . "\n");
- $self->process_node($kid);
- }
- }
- elsif ($node_type == XML_DOCUMENT_NODE
- || $node_type == XML_HTML_DOCUMENT_NODE
- || $node_type == XML_DOCUMENT_FRAG_NODE) {
- # some times it is just usefull to generate SAX events from
- # a document fragment (very good with filters).
- foreach my $kid ($node->childNodes) {
- $self->process_node($kid);
- }
- }
- elsif ($node_type == XML_PI_NODE) {
- $self->processing_instruction( { Target => $node->getName, Data => $node->getData } );
- }
- elsif ($node_type == XML_COMMENT_NODE) {
- $self->comment( { Data => $node->getData } );
- }
- elsif ( $node_type == XML_XINCLUDE_START
- || $node_type == XML_XINCLUDE_END ) {
- # ignore!
- # i may want to handle this one day, dunno yet
- }
- elsif ($node_type == XML_DTD_NODE ) {
- # ignore!
- # i will support DTDs, but had no time yet.
- }
- else {
- # warn("unsupported node type: $node_type");
- }
-
-}
-
-sub process_element {
- my ($self, $element) = @_;
-
- my $attribs = {};
- my @ns_maps = $element->getNamespaces;
-
- foreach my $ns (@ns_maps) {
- $self->start_prefix_mapping(
- {
- NamespaceURI => $ns->href,
- Prefix => ( defined $ns->localname ? $ns->localname : ''),
- }
- );
- }
-
- foreach my $attr ($element->attributes) {
- my $key;
- # warn("Attr: $attr -> ", $attr->getName, " = ", $attr->getData, "\n");
- # this isa dump thing...
- if ($attr->isa('XML::LibXML::Namespace')) {
- # TODO This needs fixing modulo agreeing on what
- # is the right thing to do here.
- unless ( defined $attr->name ) {
- ## It's an atter like "xmlns='foo'"
- $attribs->{"{}xmlns"} =
- {
- Name => "xmlns",
- LocalName => "xmlns",
- Prefix => "",
- Value => $attr->href,
- NamespaceURI => "",
- };
- }
- else {
- my $prefix = "xmlns";
- my $localname = $attr->localname;
- my $key = "{http://www.w3.org/2000/xmlns/}";
- my $name = "xmlns";
-
- if ( defined $localname ) {
- $key .= $localname;
- $name.= ":".$localname;
- }
-
- $attribs->{$key} =
- {
- Name => $name,
- Value => $attr->href,
- NamespaceURI => "http://www.w3.org/2000/xmlns/",
- Prefix => $prefix,
- LocalName => $localname,
- };
- }
- }
- else {
- my $ns = $attr->namespaceURI;
-
- $ns = '' unless defined $ns;
- $key = "{$ns}".$attr->localname;
- ## Not sure why, but $attr->name is coming through stripped
- ## of its prefix, so we need to hand-assemble a real name.
- my $name = $attr->name;
- $name = "" unless defined $name;
-
- my $prefix = $attr->prefix;
- $prefix = "" unless defined $prefix;
- $name = "$prefix:$name"
- if index( $name, ":" ) < 0 && length $prefix;
-
- $attribs->{$key} =
- {
- Name => $name,
- Value => $attr->value,
- NamespaceURI => $ns,
- Prefix => $prefix,
- LocalName => $attr->localname,
- };
- }
- # use Data::Dumper;
- # warn("Attr made: ", Dumper($attribs->{$key}), "\n");
- }
-
- my $node = {
- Name => $element->nodeName,
- Attributes => $attribs,
- NamespaceURI => $element->namespaceURI,
- Prefix => $element->prefix || "",
- LocalName => $element->localname,
- };
-
- $self->start_element($node);
-
- foreach my $child ($element->childNodes) {
- $self->process_node($child);
- }
-
- my $end_node = { %$node };
-
- delete $end_node->{Attributes};
-
- $self->end_element($end_node);
-
- foreach my $ns (@ns_maps) {
- $self->end_prefix_mapping(
- {
- NamespaceURI => $ns->href,
- Prefix => ( defined $ns->localname ? $ns->localname : ''),
- }
- );
- }
-}
-
-1;
-
-__END__
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/Schema.pod b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/Schema.pod
deleted file mode 100644
index 107301612bf..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/Schema.pod
+++ /dev/null
@@ -1,73 +0,0 @@
-=head1 NAME
-
-XML::LibXML::Schema - XML Schema Validation
-
-=head1 SYNOPSIS
-
-
-
- use XML::LibXML;
- $doc = XML::LibXML->new->parse_file($url);
-
- $xmlschema = XML::LibXML::Schema->new( location => $filename_or_url );
- $xmlschema = XML::LibXML::Schema->new( string => $xmlschemastring );
- eval { $xmlschema->validate( $doc ); };
-
-=head1 DESCRIPTION
-
-The XML::LibXML::Schema class is a tiny frontend to libxml2's XML Schema
-implementation. Currently it supports only schema parsing and document
-validation.
-
-
-=head1 METHODS
-
-=over 4
-
-=item B<new>
-
- $xmlschema = XML::LibXML::Schema->new( location => $filename_or_url );
- $xmlschema = XML::LibXML::Schema->new( string => $xmlschemastring );
-
-The constructor of XML::LibXML::Schema may get called with either one of two
-parameters. The parameter tells the class from which source it should generate
-a validation schema. It is important, that each schema only have a single
-source.
-
-The location parameter allows to parse a schema from the filesystem or a URL.
-
-The string parameter will parse the schema from the given XML string.
-
-Note that the constructor will die() if the schema does not meed the
-constraints of the XML Schema specification.
-
-
-=item B<validate>
-
- eval { $xmlschema->validate( $doc ); };
-
-This function allows to validate a (parsed) document against the given XML
-Schema. The argument of this function should be a L<<<<<< XML::LibXML DOM Document Class|XML::LibXML DOM Document Class >>>>>> object. If this function succeeds, it will return 0, otherwise it will die()
-and report the errors found. Because of this validate() should be always
-evaluated.
-
-
-
-=back
-
-=head1 AUTHORS
-
-Matt Sergeant,
-Christian Glahn,
-Petr Pajas
-
-
-=head1 VERSION
-
-1.66
-
-=head1 COPYRIGHT
-
-2001-2007, AxKit.com Ltd; 2002-2006 Christian Glahn; 2006-2008 Petr Pajas, All rights reserved.
-
-=cut
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/Text.pod b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/Text.pod
deleted file mode 100644
index 98c741489aa..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/Text.pod
+++ /dev/null
@@ -1,179 +0,0 @@
-=head1 NAME
-
-XML::LibXML::Text - XML::LibXML Class for Text Nodes
-
-=head1 SYNOPSIS
-
-
-
- use XML::LibXML;
- # Only methods specific to Text nodes are listed here,
- # see XML::LibXML::Node manpage for other methods
-
- $text = XML::LibXML::Text->new( $content );
- $nodedata = $text->data;
- $text->setData( $text_content );
- $text->substringData($offset, $length);
- $text->appendData( $somedata );
- $text->insertData($offset, $string);
- $text->deleteData($offset, $length);
- $text->deleteDataString($remstring, $all);
- $text->replaceData($offset, $length, $string);
- $text->replaceDataString($old, $new, $flag);
- $text->replaceDataRegEx( $search_cond, $replace_cond, $reflags );
-
-=head1 DESCRIPTION
-
-Unlike the DOM specification, XML::LibXML implements the text node as the base
-class of all character data node. Therefor there exists no CharacterData class.
-This allows one to apply methods of text nodes also to Comments and
-CDATA-sections.
-
-
-=head1 METHODS
-
-The class inherits from L<<<<<< Abstract Base Class of XML::LibXML Nodes|Abstract Base Class of XML::LibXML Nodes >>>>>>. The documentation for Inherited methods is not listed here.
-
-Many functions listed here are extensively documented in the L<<<<<< DOM Level 3 specification|http://www.w3.org/TR/DOM-Level-3-Core/ >>>>>>. Please refer to the specification for extensive documentation.
-
-=over 4
-
-=item B<new>
-
- $text = XML::LibXML::Text->new( $content );
-
-The constructor of the class. It creates an unbound text node.
-
-
-=item B<data>
-
- $nodedata = $text->data;
-
-Although there exists the C<<<<<< nodeValue >>>>>> attribute in the Node class, the DOM specification defines data as a separate
-attribute. C<<<<<< XML::LibXML >>>>>> implements these two attributes not as different attributes, but as aliases,
-such as C<<<<<< libxml2 >>>>>> does. Therefore
-
-
-
- $text->data;
-
-and
-
-
-
- $text->nodeValue;
-
-will have the same result and are not different entities.
-
-
-=item B<setData($string)>
-
- $text->setData( $text_content );
-
-This function sets or replaces text content to a node. The node has to be of
-the type "text", "cdata" or "comment".
-
-
-=item B<substringData($offset,$length)>
-
- $text->substringData($offset, $length);
-
-Extracts a range of data from the node. (DOM Spec) This function takes the two
-parameters $offset and $length and returns the sub-string, if available.
-
-If the node contains no data or $offset refers to an non-existing string index,
-this function will return I<<<<<< undef >>>>>>. If $length is out of range C<<<<<< substringData >>>>>> will return the data starting at $offset instead of causing an error.
-
-
-=item B<appendData($string)>
-
- $text->appendData( $somedata );
-
-Appends a string to the end of the existing data. If the current text node
-contains no data, this function has the same effect as C<<<<<< setData >>>>>>.
-
-
-=item B<insertData($offset,$string)>
-
- $text->insertData($offset, $string);
-
-Inserts the parameter $string at the given $offset of the existing data of the
-node. This operation will not remove existing data, but change the order of the
-existing data.
-
-The $offset has to be a positive value. If $offset is out of range, C<<<<<< insertData >>>>>> will have the same behaviour as C<<<<<< appendData >>>>>>.
-
-
-=item B<deleteData($offset, $length)>
-
- $text->deleteData($offset, $length);
-
-This method removes a chunk from the existing node data at the given offset.
-The $length parameter tells, how many characters should be removed from the
-string.
-
-
-=item B<deleteDataString($string, [$all])>
-
- $text->deleteDataString($remstring, $all);
-
-This method removes a chunk from the existing node data. Since the DOM spec is
-quite unhandy if you already know C<<<<<< which >>>>>> string to remove from a text node, this method allows more perlish code :)
-
-The functions takes two parameters: I<<<<<< $string >>>>>> and optional the I<<<<<< $all >>>>>> flag. If $all is not set, I<<<<<< undef >>>>>> or I<<<<<< 0 >>>>>>, C<<<<<< deleteDataString >>>>>> will remove only the first occurrence of $string. If $all is I<<<<<< TRUE >>>>>>C<<<<<< deleteDataString >>>>>> will remove all occurrences of I<<<<<< $string >>>>>> from the node data.
-
-
-=item B<replaceData($offset, $length, $string)>
-
- $text->replaceData($offset, $length, $string);
-
-The DOM style version to replace node data.
-
-
-=item B<replaceDataString($oldstring, $newstring, [$all])>
-
- $text->replaceDataString($old, $new, $flag);
-
-The more programmer friendly version of replaceData() :)
-
-Instead of giving offsets and length one can specify the exact string (I<<<<<< $oldstring >>>>>>) to be replaced. Additionally the I<<<<<< $all >>>>>> flag allows to replace all occurrences of I<<<<<< $oldstring >>>>>>.
-
-
-=item B<replaceDataRegEx( $search_cond, $replace_cond, $reflags )>
-
- $text->replaceDataRegEx( $search_cond, $replace_cond, $reflags );
-
-This method replaces the node's data by a C<<<<<< simple >>>>>> regular expression. Optional, this function allows to pass some flags that will
-be added as flag to the replace statement.
-
-I<<<<<< NOTE: >>>>>> This is a shortcut for
-
-
-
- my $datastr = $node->getData();
- $datastr =~ s/somecond/replacement/g; # 'g' is just an example for any flag
- $node->setData( $datastr );
-
-This function can make things easier to read for simple replacements. For more
-complex variants it is recommended to use the code snippet above.
-
-
-
-=back
-
-=head1 AUTHORS
-
-Matt Sergeant,
-Christian Glahn,
-Petr Pajas
-
-
-=head1 VERSION
-
-1.66
-
-=head1 COPYRIGHT
-
-2001-2007, AxKit.com Ltd; 2002-2006 Christian Glahn; 2006-2008 Petr Pajas, All rights reserved.
-
-=cut
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/XPathContext.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/XPathContext.pm
deleted file mode 100644
index 903a260e2d5..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/XPathContext.pm
+++ /dev/null
@@ -1,131 +0,0 @@
-# $Id: XPathContext.pm 422 2002-11-08 17:10:30Z phish $
-
-package XML::LibXML::XPathContext;
-
-use strict;
-use vars qw($VERSION @ISA $USE_LIBXML_DATA_TYPES);
-
-use Carp;
-use XML::LibXML;
-use XML::LibXML::NodeList;
-
-$VERSION = "1.66"; # VERSION TEMPLATE: DO NOT CHANGE
-
-# should LibXML XPath data types be used for simple objects
-# when passing parameters to extension functions (default: no)
-$USE_LIBXML_DATA_TYPES = 0;
-
-sub findnodes {
- my ($self, $xpath, $node) = @_;
-
- my @nodes = $self->_guarded_find_call('_findnodes', $xpath, $node);
-
- if (wantarray) {
- return @nodes;
- }
- else {
- return XML::LibXML::NodeList->new(@nodes);
- }
-}
-
-sub find {
- my ($self, $xpath, $node) = @_;
-
- my ($type, @params) = $self->_guarded_find_call('_find', $xpath, $node);
-
- if ($type) {
- return $type->new(@params);
- }
- return undef;
-}
-
-sub findvalue {
- my $self = shift;
- return $self->find(@_)->to_literal->value;
-}
-
-sub _guarded_find_call {
- my ($self, $method, $xpath, $node) = @_;
-
- my $prev_node;
- if (ref($node)) {
- $prev_node = $self->getContextNode();
- $self->setContextNode($node);
- }
- my @ret;
- eval {
- @ret = $self->$method($xpath);
- };
- $self->_free_node_pool;
- $self->setContextNode($prev_node) if ref($node);
-
- if ($@) {
- my $err = $@;
- chomp $err;
- croak $err;
- }
-
- return @ret;
-}
-
-sub registerFunction {
- my ($self, $name, $sub) = @_;
- $self->registerFunctionNS($name, undef, $sub);
- return;
-}
-
-sub unregisterNs {
- my ($self, $prefix) = @_;
- $self->registerNs($prefix, undef);
- return;
-}
-
-sub unregisterFunction {
- my ($self, $name) = @_;
- $self->registerFunctionNS($name, undef, undef);
- return;
-}
-
-sub unregisterFunctionNS {
- my ($self, $name, $ns) = @_;
- $self->registerFunctionNS($name, $ns, undef);
- return;
-}
-
-sub unregisterVarLookupFunc {
- my ($self) = @_;
- $self->registerVarLookupFunc(undef, undef);
- return;
-}
-
-# extension function perl dispatcher
-# borrowed from XML::LibXSLT
-
-sub _perl_dispatcher {
- my $func = shift;
- my @params = @_;
- my @perlParams;
-
- my $i = 0;
- while (@params) {
- my $type = shift(@params);
- if ($type eq 'XML::LibXML::Literal' or
- $type eq 'XML::LibXML::Number' or
- $type eq 'XML::LibXML::Boolean')
- {
- my $val = shift(@params);
- unshift(@perlParams, $USE_LIBXML_DATA_TYPES ? $type->new($val) : $val);
- }
- elsif ($type eq 'XML::LibXML::NodeList') {
- my $node_count = shift(@params);
- unshift(@perlParams, $type->new(splice(@params, 0, $node_count)));
- }
- }
-
- $func = "main::$func" unless ref($func) || $func =~ /(.+)::/;
- no strict 'refs';
- my $res = $func->(@perlParams);
- return $res;
-}
-
-1;
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/XPathContext.pod b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/XPathContext.pod
deleted file mode 100644
index 328c88a2ec3..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/XPathContext.pod
+++ /dev/null
@@ -1,349 +0,0 @@
-=head1 NAME
-
-XML::LibXML::XPathContext - XPath Evaluation
-
-=head1 SYNOPSIS
-
- my $xpc = XML::LibXML::XPathContext->new();
- my $xpc = XML::LibXML::XPathContext->new($node);
- $xpc->registerNs($prefix, $namespace_uri)
- $xpc->unregisterNs($prefix)
- $uri = $xpc->lookupNs($prefix)
- $xpc->registerVarLookupFunc($callback, $data)
- $data = $xpc->getVarLookupData();
- $callback = $xpc->getVarLookupFunc();
- $xpc->unregisterVarLookupFunc($name);
- $xpc->registerFunctionNS($name, $uri, $callback)
- $xpc->unregisterFunctionNS($name, $uri)
- $xpc->registerFunction($name, $callback)
- $xpc->unregisterFunction($name)
- @nodes = $xpc->findnodes($xpath)
- @nodes = $xpc->findnodes($xpath, $context_node )
- $nodelist = $xpc->findnodes($xpath, $context_node )
- $object = $xpc->find($xpath )
- $object = $xpc->find($xpath, $context_node )
- $value = $xpc->findvalue($xpath )
- $value = $xpc->findvalue($xpath, $context_node )
- $xpc->setContextNode($node)
- my $node = $xpc->getContextNode;
- $xpc->setContextPosition($position)
- my $position = $xpc->getContextPosition;
- $xpc->setContextSize($size)
- my $size = $xpc->getContextSize;
- $xpc->setContextNode($node)
-The XML::LibXML::XPathContext class provides an almost complete interface to
-libxml2's XPath implementation. With XML::LibXML::XPathContext is is possible
-to evaluate XPath expressions in the context of arbitrary node, context size,
-and context position, with a user-defined namespace-prefix mapping, custom
-XPath functions written in Perl, and even a custom XPath variable resolver.
-
-
-=head1 EXAMPLES
-
-
-=head2 Namespaces
-
-This example demonstrates C<<<<<< registerNs() >>>>>> method. It finds all paragraph nodes in an XHTML document.
-
-
-
- my $xc = XML::LibXML::XPathContext->new($xhtml_doc);
- $xc->registerNs('xhtml', 'http://www.w3.org/1999/xhtml');
- my @nodes = $xc->findnodes('//xhtml:p');
-
-
-=head2 Custom XPath functions
-
-This example demonstrates C<<<<<< registerFunction() >>>>>> method by defining a function filtering nodes based on a Perl regular
-expression:
-
-
-
- sub grep_nodes {
- my ($nodelist,$regexp) = @_;
- my $result = XML::LibXML::NodeList->new;
- for my $node ($nodelist->get_nodelist()) {
- $result->push($node) if $node->textContent =~ $regexp;
- }
- return $result;
- };
-
- my $xc = XML::LibXML::XPathContext->new($node);
- $xc->registerFunction('grep_nodes', \&grep_nodes);
- my @nodes = $xc->findnodes('//section[grep_nodes(para,"\bsearch(ing|es)?\b")]');
-
-
-=head2 Variables
-
-This example demonstrates C<<<<<< registerVarLookup() >>>>>> method. We use XPath variables to recycle results of previous evaluations:
-
-
-
- sub var_lookup {
- my ($varname,$ns,$data)=@_;
- return $data->{$varname};
- }
-
- my $areas = XML::LibXML->new->parse_file('areas.xml');
- my $empl = XML::LibXML->new->parse_file('employees.xml');
-
- my $xc = XML::LibXML::XPathContext->new($empl);
-
- my %variables = (
- A => $xc->find('/employees/employee[@salary>10000]'),
- B => $areas->find('/areas/area[district='Brooklyn']/street'),
- );
-
- # get names of employees from $A working in an area listed in $B
- $xc->registerVarLookupFunc(\&var_lookup, \%variables);
- my @nodes = $xc->findnodes('$A[work_area/street = $B]/name');
-
-
-=head1 METHODS
-
-=over 4
-
-=item B<new>
-
- my $xpc = XML::LibXML::XPathContext->new();
-
-Creates a new XML::LibXML::XPathContext object without a context node.
-
- my $xpc = XML::LibXML::XPathContext->new($node);
-
-Creates a new XML::LibXML::XPathContext object with the context node set to C<<<<<< $node >>>>>>.
-
-
-=item B<registerNs>
-
- $xpc->registerNs($prefix, $namespace_uri)
-
-Registers namespace C<<<<<< $prefix >>>>>> to C<<<<<< $namespace_uri >>>>>>.
-
-
-=item B<unregisterNs>
-
- $xpc->unregisterNs($prefix)
-
-Unregisters namespace C<<<<<< $prefix >>>>>>.
-
-
-=item B<lookupNs>
-
- $uri = $xpc->lookupNs($prefix)
-
-Returns namespace URI registered with C<<<<<< $prefix >>>>>>. If C<<<<<< $prefix >>>>>> is not registered to any namespace URI returns C<<<<<< undef >>>>>>.
-
-
-=item B<registerVarLookupFunc>
-
- $xpc->registerVarLookupFunc($callback, $data)
-
-Registers variable lookup function C<<<<<< $prefix >>>>>>. The registered function is executed by the XPath engine each time an XPath
-variable is evaluated. It takes three arguments: C<<<<<< $data >>>>>>, variable name, and variable ns-URI and must return one value: a number or
-string or any C<<<<<< XML::LibXML:: >>>>>> object that can be a result of findnodes: Boolean, Literal, Number, Node (e.g.
-Document, Element, etc.), or NodeList. For convenience, simple (non-blessed)
-array references containing only L<<<<<< Abstract Base Class of XML::LibXML Nodes|Abstract Base Class of XML::LibXML Nodes >>>>>> objects can be used instead of a L<<<<<< XML::LibXML::NodeList|XML::LibXML::NodeList >>>>>>.
-
-
-=item B<getVarLookupData>
-
- $data = $xpc->getVarLookupData();
-
-Returns the data that have been associated with a variable lookup function
-during a previous call to C<<<<<< registerVarLookupFunc >>>>>>.
-
-
-=item B<getVarLookupFunc>
-
- $callback = $xpc->getVarLookupFunc();
-
-Returns the variable lookup function previously registered with C<<<<<< registerVarLookupFunc >>>>>>.
-
-
-=item B<unregisterVarLookupFunc>
-
- $xpc->unregisterVarLookupFunc($name);
-
-Unregisters variable lookup function and the associated lookup data.
-
-
-=item B<registerFunctionNS>
-
- $xpc->registerFunctionNS($name, $uri, $callback)
-
-Registers an extension function C<<<<<< $name >>>>>> in C<<<<<< $uri >>>>>> namespace. C<<<<<< $callback >>>>>> must be a CODE reference. The arguments of the callback function are either
-simple scalars or C<<<<<< XML::LibXML::* >>>>>> objects depending on the XPath argument types. The function is responsible for
-checking the argument number and types. Result of the callback code must be a
-single value of the following types: a simple scalar (number, string) or an
-arbitrary C<<<<<< XML::LibXML::* >>>>>> object that can be a result of findnodes: Boolean, Literal, Number, Node (e.g.
-Document, Element, etc.), or NodeList. For convenience, simple (non-blessed)
-array references containing only L<<<<<< Abstract Base Class of XML::LibXML Nodes|Abstract Base Class of XML::LibXML Nodes >>>>>> objects can be used instead of a L<<<<<< XML::LibXML::NodeList|XML::LibXML::NodeList >>>>>>.
-
-
-=item B<unregisterFunctionNS>
-
- $xpc->unregisterFunctionNS($name, $uri)
-
-Unregisters extension function C<<<<<< $name >>>>>> in C<<<<<< $uri >>>>>> namespace. Has the same effect as passing C<<<<<< undef >>>>>> as C<<<<<< $callback >>>>>> to registerFunctionNS.
-
-
-=item B<registerFunction>
-
- $xpc->registerFunction($name, $callback)
-
-Same as C<<<<<< registerFunctionNS >>>>>> but without a namespace.
-
-
-=item B<unregisterFunction>
-
- $xpc->unregisterFunction($name)
-
-Same as C<<<<<< unregisterFunctionNS >>>>>> but without a namespace.
-
-
-=item B<findnodes>
-
- @nodes = $xpc->findnodes($xpath)
-
- @nodes = $xpc->findnodes($xpath, $context_node )
-
- $nodelist = $xpc->findnodes($xpath, $context_node )
-
-Performs the xpath statement on the current node and returns the result as an
-array. In scalar context returns a L<<<<<< XML::LibXML::NodeList|XML::LibXML::NodeList >>>>>> object. Optionally, a node may be passed as a second argument to set the
-context node for the query.
-
-
-=item B<find>
-
- $object = $xpc->find($xpath )
-
- $object = $xpc->find($xpath, $context_node )
-
-Performs the xpath expression using the current node as the context of the
-expression, and returns the result depending on what type of result the XPath
-expression had. For example, the XPath C<<<<<< 1 * 3 + 52 >>>>>> results in a L<<<<<< XML::LibXML::Number|XML::LibXML::Number >>>>>> object being returned. Other expressions might return a L<<<<<< XML::LibXML::Boolean|XML::LibXML::Boolean >>>>>> object, or a L<<<<<< XML::LibXML::Literal|XML::LibXML::Literal >>>>>> object (a string). Each of those objects uses Perl's overload feature to ``do
-the right thing'' in different contexts. Optionally, a node may be passed as a
-second argument to set the context node for the query.
-
-
-=item B<findvalue>
-
- $value = $xpc->findvalue($xpath )
-
- $value = $xpc->findvalue($xpath, $context_node )
-
-Is exactly equivalent to:
-
-
-
- $node->find( $xpath )->to_literal;
-
-That is, it returns the literal value of the results. This enables you to
-ensure that you get a string back from your search, allowing certain shortcuts.
-This could be used as the equivalent of <xsl:value-of select=``some_xpath''/>.
-Optionally, a node may be passed in the second argument to set the context node
-for the query.
-
-
-=item B<setContextNode>
-
- $xpc->setContextNode($node)
-
-Set the current context node.
-
-
-=item B<getContextNode>
-
- my $node = $xpc->getContextNode;
-
-Get the current context node.
-
-
-=item B<setContextPosition>
-
- $xpc->setContextPosition($position)
-
-Set the current context position. By default, this value is -1 (and evaluating
-XPath function C<<<<<< position() >>>>>> in the initial context raises an XPath error), but can be set to any value up
-to context size. This usually only serves to cheat the XPath engine to return
-given position when C<<<<<< position() >>>>>> XPath function is called. Setting this value to -1 restores the default
-behavior.
-
-
-=item B<getContextPosition>
-
- my $position = $xpc->getContextPosition;
-
-Get the current context position.
-
-
-=item B<setContextSize>
-
- $xpc->setContextSize($size)
-
-Set the current context size. By default, this value is -1 (and evaluating
-XPath function C<<<<<< last() >>>>>> in the initial context raises an XPath error), but can be set to any
-non-negative value. This usually only serves to cheat the XPath engine to
-return the given value when C<<<<<< last() >>>>>> XPath function is called. If context size is set to 0, position is
-automatically also set to 0. If context size is positive, position is
-automatically set to 1. Setting context size to -1 restores the default
-behavior.
-
-
-=item B<getContextSize>
-
- my $size = $xpc->getContextSize;
-
-Get the current context size.
-
-
-=item B<setContextNode>
-
- $xpc->setContextNode($node)
-
-Set the current context node.
-
-
-
-=back
-
-
-=head1 BUGS AND CAVEATS
-
-XML::LibXML::XPathContext objects I<<<<<< are >>>>>> reentrant, meaning that you can call methods of an XML::LibXML::XPathContext
-even from XPath extension functions registered with the same object or from a
-variable lookup function. On the other hand, you should rather avoid
-registering new extension functions, namespaces and a variable lookup function
-from within extension functions and a variable lookup function, unless you want
-to experience untested behavior.
-
-
-=head1 AUTHORS
-
-Ilya Martynov and Petr Pajas, based on XML::LibXML and XML::LibXSLT code by
-Matt Sergeant and Christian Glahn.
-
-
-=head1 HISTORICAL REMARK
-
-Prior to XML::LibXML 1.61 this module was distributed separately for
-maintenance reasons.
-
-=head1 AUTHORS
-
-Matt Sergeant,
-Christian Glahn,
-Petr Pajas
-
-
-=head1 VERSION
-
-1.66
-
-=head1 COPYRIGHT
-
-2001-2007, AxKit.com Ltd; 2002-2006 Christian Glahn; 2006-2008 Petr Pajas, All rights reserved.
-
-=cut
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/Parser.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/Parser.pm
deleted file mode 100644
index 064b021ec5b..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/Parser.pm
+++ /dev/null
@@ -1,840 +0,0 @@
-# XML::Parser
-#
-# Copyright (c) 1998-2000 Larry Wall and Clark Cooper
-# All rights reserved.
-#
-# This program is free software; you can redistribute it and/or
-# modify it under the same terms as Perl itself.
-
-package XML::Parser;
-
-use Carp;
-
-BEGIN {
- require XML::Parser::Expat;
- $VERSION = '2.36';
- die "Parser.pm and Expat.pm versions don't match"
- unless $VERSION eq $XML::Parser::Expat::VERSION;
-}
-
-use strict;
-
-use vars qw($VERSION $LWP_load_failed);
-
-$LWP_load_failed = 0;
-
-sub new {
- my ($class, %args) = @_;
- my $style = $args{Style};
-
- my $nonexopt = $args{Non_Expat_Options} ||= {};
-
- $nonexopt->{Style} = 1;
- $nonexopt->{Non_Expat_Options} = 1;
- $nonexopt->{Handlers} = 1;
- $nonexopt->{_HNDL_TYPES} = 1;
- $nonexopt->{NoLWP} = 1;
-
- $args{_HNDL_TYPES} = {%XML::Parser::Expat::Handler_Setters};
- $args{_HNDL_TYPES}->{Init} = 1;
- $args{_HNDL_TYPES}->{Final} = 1;
-
- $args{Handlers} ||= {};
- my $handlers = $args{Handlers};
-
- if (defined($style)) {
- my $stylepkg = $style;
-
- if ($stylepkg !~ /::/) {
- $stylepkg = "\u$style";
-
- eval {
- my $fullpkg = 'XML::Parser::Style::' . $stylepkg;
- my $stylefile = $fullpkg;
- $stylefile =~ s/::/\//g;
- require "$stylefile.pm";
- $stylepkg = $fullpkg;
- };
- if ($@) {
- # fallback to old behaviour
- $stylepkg = 'XML::Parser::' . $stylepkg;
- }
- }
-
- my $htype;
- foreach $htype (keys %{$args{_HNDL_TYPES}}) {
- # Handlers explicity given override
- # handlers from the Style package
- unless (defined($handlers->{$htype})) {
-
- # A handler in the style package must either have
- # exactly the right case as the type name or a
- # completely lower case version of it.
-
- my $hname = "${stylepkg}::$htype";
- if (defined(&$hname)) {
- $handlers->{$htype} = \&$hname;
- next;
- }
-
- $hname = "${stylepkg}::\L$htype";
- if (defined(&$hname)) {
- $handlers->{$htype} = \&$hname;
- next;
- }
- }
- }
- }
-
- unless (defined($handlers->{ExternEnt})
- or defined ($handlers->{ExternEntFin})) {
-
- if ($args{NoLWP} or $LWP_load_failed) {
- $handlers->{ExternEnt} = \&file_ext_ent_handler;
- $handlers->{ExternEntFin} = \&file_ext_ent_cleanup;
- }
- else {
- # The following just bootstraps the real LWP external entity
- # handler
-
- $handlers->{ExternEnt} = \&initial_ext_ent_handler;
-
- # No cleanup function available until LWPExternEnt.pl loaded
- }
- }
-
- $args{Pkg} ||= caller;
- bless \%args, $class;
-} # End of new
-
-sub setHandlers {
- my ($self, @handler_pairs) = @_;
-
- croak("Uneven number of arguments to setHandlers method")
- if (int(@handler_pairs) & 1);
-
- my @ret;
- while (@handler_pairs) {
- my $type = shift @handler_pairs;
- my $handler = shift @handler_pairs;
- unless (defined($self->{_HNDL_TYPES}->{$type})) {
- my @types = sort keys %{$self->{_HNDL_TYPES}};
-
- croak("Unknown Parser handler type: $type\n Valid types: @types");
- }
- push(@ret, $type, $self->{Handlers}->{$type});
- $self->{Handlers}->{$type} = $handler;
- }
-
- return @ret;
-}
-
-sub parse_start {
- my $self = shift;
- my @expat_options = ();
-
- my ($key, $val);
- while (($key, $val) = each %{$self}) {
- push (@expat_options, $key, $val)
- unless exists $self->{Non_Expat_Options}->{$key};
- }
-
- my %handlers = %{$self->{Handlers}};
- my $init = delete $handlers{Init};
- my $final = delete $handlers{Final};
-
- my $expatnb = new XML::Parser::ExpatNB(@expat_options, @_);
- $expatnb->setHandlers(%handlers);
-
- &$init($expatnb)
- if defined($init);
-
- $expatnb->{_State_} = 1;
-
- $expatnb->{FinalHandler} = $final
- if defined($final);
-
- return $expatnb;
-}
-
-sub parse {
- my $self = shift;
- my $arg = shift;
- my @expat_options = ();
- my ($key, $val);
- while (($key, $val) = each %{$self}) {
- push(@expat_options, $key, $val)
- unless exists $self->{Non_Expat_Options}->{$key};
- }
-
- my $expat = new XML::Parser::Expat(@expat_options, @_);
- my %handlers = %{$self->{Handlers}};
- my $init = delete $handlers{Init};
- my $final = delete $handlers{Final};
-
- $expat->setHandlers(%handlers);
-
- if ($self->{Base}) {
- $expat->base($self->{Base});
- }
-
- &$init($expat)
- if defined($init);
-
- my @result = ();
- my $result;
- eval {
- $result = $expat->parse($arg);
- };
- my $err = $@;
- if ($err) {
- $expat->release;
- die $err;
- }
-
- if ($result and defined($final)) {
- if (wantarray) {
- @result = &$final($expat);
- }
- else {
- $result = &$final($expat);
- }
- }
-
- $expat->release;
-
- return unless defined wantarray;
- return wantarray ? @result : $result;
-}
-
-sub parsestring {
- my $self = shift;
- $self->parse(@_);
-}
-
-sub parsefile {
- my $self = shift;
- my $file = shift;
- local(*FILE);
- open(FILE, $file) or croak "Couldn't open $file:\n$!";
- binmode(FILE);
- my @ret;
- my $ret;
-
- $self->{Base} = $file;
-
- if (wantarray) {
- eval {
- @ret = $self->parse(*FILE, @_);
- };
- }
- else {
- eval {
- $ret = $self->parse(*FILE, @_);
- };
- }
- my $err = $@;
- close(FILE);
- die $err if $err;
-
- return unless defined wantarray;
- return wantarray ? @ret : $ret;
-}
-
-sub initial_ext_ent_handler {
- # This just bootstraps in the real lwp_ext_ent_handler which
- # also loads the URI and LWP modules.
-
- unless ($LWP_load_failed) {
- local($^W) = 0;
-
- my $stat =
- eval {
- require('XML/Parser/LWPExternEnt.pl');
- };
-
- if ($stat) {
- $_[0]->setHandlers(ExternEnt => \&lwp_ext_ent_handler,
- ExternEntFin => \&lwp_ext_ent_cleanup);
-
- goto &lwp_ext_ent_handler;
- }
-
- # Failed to load lwp handler, act as if NoLWP
-
- $LWP_load_failed = 1;
-
- my $cmsg = "Couldn't load LWP based external entity handler\n";
- $cmsg .= "Switching to file-based external entity handler\n";
- $cmsg .= " (To avoid this message, use NoLWP option to XML::Parser)\n";
- warn($cmsg);
- }
-
- $_[0]->setHandlers(ExternEnt => \&file_ext_ent_handler,
- ExternEntFin => \&file_ext_ent_cleanup);
- goto &file_ext_ent_handler;
-
-}
-
-sub file_ext_ent_handler {
- my ($xp, $base, $path) = @_;
-
- # Prepend base only for relative paths
-
- if (defined($base)
- and not ($path =~ m!^(?:[\\/]|\w+:)!))
- {
- my $newpath = $base;
- $newpath =~ s![^\\/:]*$!$path!;
- $path = $newpath;
- }
-
- if ($path =~ /^\s*[|>+]/
- or $path =~ /\|\s*$/) {
- $xp->{ErrorMessage}
- .= "System ID ($path) contains Perl IO control characters";
- return undef;
- }
-
- require IO::File;
- my $fh = new IO::File($path);
- unless (defined $fh) {
- $xp->{ErrorMessage}
- .= "Failed to open $path:\n$!";
- return undef;
- }
-
- $xp->{_BaseStack} ||= [];
- $xp->{_FhStack} ||= [];
-
- push(@{$xp->{_BaseStack}}, $base);
- push(@{$xp->{_FhStack}}, $fh);
-
- $xp->base($path);
-
- return $fh;
-}
-
-sub file_ext_ent_cleanup {
- my ($xp) = @_;
-
- my $fh = pop(@{$xp->{_FhStack}});
- $fh->close;
-
- my $base = pop(@{$xp->{_BaseStack}});
- $xp->base($base);
-}
-
-1;
-
-__END__
-
-=head1 NAME
-
-XML::Parser - A perl module for parsing XML documents
-
-=head1 SYNOPSIS
-
- use XML::Parser;
-
- $p1 = new XML::Parser(Style => 'Debug');
- $p1->parsefile('REC-xml-19980210.xml');
- $p1->parse('<foo id="me">Hello World</foo>');
-
- # Alternative
- $p2 = new XML::Parser(Handlers => {Start => \&handle_start,
- End => \&handle_end,
- Char => \&handle_char});
- $p2->parse($socket);
-
- # Another alternative
- $p3 = new XML::Parser(ErrorContext => 2);
-
- $p3->setHandlers(Char => \&text,
- Default => \&other);
-
- open(FOO, 'xmlgenerator |');
- $p3->parse(*FOO, ProtocolEncoding => 'ISO-8859-1');
- close(FOO);
-
- $p3->parsefile('junk.xml', ErrorContext => 3);
-
-=begin man
-.ds PI PI
-
-=end man
-
-=head1 DESCRIPTION
-
-This module provides ways to parse XML documents. It is built on top of
-L<XML::Parser::Expat>, which is a lower level interface to James Clark's
-expat library. Each call to one of the parsing methods creates a new
-instance of XML::Parser::Expat which is then used to parse the document.
-Expat options may be provided when the XML::Parser object is created.
-These options are then passed on to the Expat object on each parse call.
-They can also be given as extra arguments to the parse methods, in which
-case they override options given at XML::Parser creation time.
-
-The behavior of the parser is controlled either by C<L</Style>> and/or
-C<L</Handlers>> options, or by L</setHandlers> method. These all provide
-mechanisms for XML::Parser to set the handlers needed by XML::Parser::Expat.
-If neither C<Style> nor C<Handlers> are specified, then parsing just
-checks the document for being well-formed.
-
-When underlying handlers get called, they receive as their first parameter
-the I<Expat> object, not the Parser object.
-
-=head1 METHODS
-
-=over 4
-
-=item new
-
-This is a class method, the constructor for XML::Parser. Options are passed
-as keyword value pairs. Recognized options are:
-
-=over 4
-
-=item * Style
-
-This option provides an easy way to create a given style of parser. The
-built in styles are: L<"Debug">, L<"Subs">, L<"Tree">, L<"Objects">,
-and L<"Stream">. These are all defined in separate packages under
-C<XML::Parser::Style::*>, and you can find further documentation for
-each style both below, and in those packages.
-
-Custom styles can be provided by giving a full package name containing
-at least one '::'. This package should then have subs defined for each
-handler it wishes to have installed. See L<"STYLES"> below
-for a discussion of each built in style.
-
-=item * Handlers
-
-When provided, this option should be an anonymous hash containing as
-keys the type of handler and as values a sub reference to handle that
-type of event. All the handlers get passed as their 1st parameter the
-instance of expat that is parsing the document. Further details on
-handlers can be found in L<"HANDLERS">. Any handler set here
-overrides the corresponding handler set with the Style option.
-
-=item * Pkg
-
-Some styles will refer to subs defined in this package. If not provided,
-it defaults to the package which called the constructor.
-
-=item * ErrorContext
-
-This is an Expat option. When this option is defined, errors are reported
-in context. The value should be the number of lines to show on either side
-of the line in which the error occurred.
-
-=item * ProtocolEncoding
-
-This is an Expat option. This sets the protocol encoding name. It defaults
-to none. The built-in encodings are: C<UTF-8>, C<ISO-8859-1>, C<UTF-16>, and
-C<US-ASCII>. Other encodings may be used if they have encoding maps in one
-of the directories in the @Encoding_Path list. Check L<"ENCODINGS"> for
-more information on encoding maps. Setting the protocol encoding overrides
-any encoding in the XML declaration.
-
-=item * Namespaces
-
-This is an Expat option. If this is set to a true value, then namespace
-processing is done during the parse. See L<XML::Parser::Expat/"Namespaces">
-for further discussion of namespace processing.
-
-=item * NoExpand
-
-This is an Expat option. Normally, the parser will try to expand references
-to entities defined in the internal subset. If this option is set to a true
-value, and a default handler is also set, then the default handler will be
-called when an entity reference is seen in text. This has no effect if a
-default handler has not been registered, and it has no effect on the expansion
-of entity references inside attribute values.
-
-=item * Stream_Delimiter
-
-This is an Expat option. It takes a string value. When this string is found
-alone on a line while parsing from a stream, then the parse is ended as if it
-saw an end of file. The intended use is with a stream of xml documents in a
-MIME multipart format. The string should not contain a trailing newline.
-
-=item * ParseParamEnt
-
-This is an Expat option. Unless standalone is set to "yes" in the XML
-declaration, setting this to a true value allows the external DTD to be read,
-and parameter entities to be parsed and expanded.
-
-=item * NoLWP
-
-This option has no effect if the ExternEnt or ExternEntFin handlers are
-directly set. Otherwise, if true, it forces the use of a file based external
-entity handler.
-
-=item * Non-Expat-Options
-
-If provided, this should be an anonymous hash whose keys are options that
-shouldn't be passed to Expat. This should only be of concern to those
-subclassing XML::Parser.
-
-=back
-
-=item setHandlers(TYPE, HANDLER [, TYPE, HANDLER [...]])
-
-This method registers handlers for various parser events. It overrides any
-previous handlers registered through the Style or Handler options or through
-earlier calls to setHandlers. By providing a false or undefined value as
-the handler, the existing handler can be unset.
-
-This method returns a list of type, handler pairs corresponding to the
-input. The handlers returned are the ones that were in effect prior to
-the call.
-
-See a description of the handler types in L<"HANDLERS">.
-
-=item parse(SOURCE [, OPT => OPT_VALUE [...]])
-
-The SOURCE parameter should either be a string containing the whole XML
-document, or it should be an open IO::Handle. Constructor options to
-XML::Parser::Expat given as keyword-value pairs may follow the SOURCE
-parameter. These override, for this call, any options or attributes passed
-through from the XML::Parser instance.
-
-A die call is thrown if a parse error occurs. Otherwise it will return 1
-or whatever is returned from the B<Final> handler, if one is installed.
-In other words, what parse may return depends on the style.
-
-=item parsestring
-
-This is just an alias for parse for backwards compatibility.
-
-=item parsefile(FILE [, OPT => OPT_VALUE [...]])
-
-Open FILE for reading, then call parse with the open handle. The file
-is closed no matter how parse returns. Returns what parse returns.
-
-=item parse_start([ OPT => OPT_VALUE [...]])
-
-Create and return a new instance of XML::Parser::ExpatNB. Constructor
-options may be provided. If an init handler has been provided, it is
-called before returning the ExpatNB object. Documents are parsed by
-making incremental calls to the parse_more method of this object, which
-takes a string. A single call to the parse_done method of this object,
-which takes no arguments, indicates that the document is finished.
-
-If there is a final handler installed, it is executed by the parse_done
-method before returning and the parse_done method returns whatever is
-returned by the final handler.
-
-=back
-
-=head1 HANDLERS
-
-Expat is an event based parser. As the parser recognizes parts of the
-document (say the start or end tag for an XML element), then any handlers
-registered for that type of an event are called with suitable parameters.
-All handlers receive an instance of XML::Parser::Expat as their first
-argument. See L<XML::Parser::Expat/"METHODS"> for a discussion of the
-methods that can be called on this object.
-
-=head2 Init (Expat)
-
-This is called just before the parsing of the document starts.
-
-=head2 Final (Expat)
-
-This is called just after parsing has finished, but only if no errors
-occurred during the parse. Parse returns what this returns.
-
-=head2 Start (Expat, Element [, Attr, Val [,...]])
-
-This event is generated when an XML start tag is recognized. Element is the
-name of the XML element type that is opened with the start tag. The Attr &
-Val pairs are generated for each attribute in the start tag.
-
-=head2 End (Expat, Element)
-
-This event is generated when an XML end tag is recognized. Note that
-an XML empty tag (<foo/>) generates both a start and an end event.
-
-=head2 Char (Expat, String)
-
-This event is generated when non-markup is recognized. The non-markup
-sequence of characters is in String. A single non-markup sequence of
-characters may generate multiple calls to this handler. Whatever the
-encoding of the string in the original document, this is given to the
-handler in UTF-8.
-
-=head2 Proc (Expat, Target, Data)
-
-This event is generated when a processing instruction is recognized.
-
-=head2 Comment (Expat, Data)
-
-This event is generated when a comment is recognized.
-
-=head2 CdataStart (Expat)
-
-This is called at the start of a CDATA section.
-
-=head2 CdataEnd (Expat)
-
-This is called at the end of a CDATA section.
-
-=head2 Default (Expat, String)
-
-This is called for any characters that don't have a registered handler.
-This includes both characters that are part of markup for which no
-events are generated (markup declarations) and characters that
-could generate events, but for which no handler has been registered.
-
-Whatever the encoding in the original document, the string is returned to
-the handler in UTF-8.
-
-=head2 Unparsed (Expat, Entity, Base, Sysid, Pubid, Notation)
-
-This is called for a declaration of an unparsed entity. Entity is the name
-of the entity. Base is the base to be used for resolving a relative URI.
-Sysid is the system id. Pubid is the public id. Notation is the notation
-name. Base and Pubid may be undefined.
-
-=head2 Notation (Expat, Notation, Base, Sysid, Pubid)
-
-This is called for a declaration of notation. Notation is the notation name.
-Base is the base to be used for resolving a relative URI. Sysid is the system
-id. Pubid is the public id. Base, Sysid, and Pubid may all be undefined.
-
-=head2 ExternEnt (Expat, Base, Sysid, Pubid)
-
-This is called when an external entity is referenced. Base is the base to be
-used for resolving a relative URI. Sysid is the system id. Pubid is the public
-id. Base, and Pubid may be undefined.
-
-This handler should either return a string, which represents the contents of
-the external entity, or return an open filehandle that can be read to obtain
-the contents of the external entity, or return undef, which indicates the
-external entity couldn't be found and will generate a parse error.
-
-If an open filehandle is returned, it must be returned as either a glob
-(*FOO) or as a reference to a glob (e.g. an instance of IO::Handle).
-
-A default handler is installed for this event. The default handler is
-XML::Parser::lwp_ext_ent_handler unless the NoLWP option was provided with
-a true value, otherwise XML::Parser::file_ext_ent_handler is the default
-handler for external entities. Even without the NoLWP option, if the
-URI or LWP modules are missing, the file based handler ends up being used
-after giving a warning on the first external entity reference.
-
-The LWP external entity handler will use proxies defined in the environment
-(http_proxy, ftp_proxy, etc.).
-
-Please note that the LWP external entity handler reads the entire
-entity into a string and returns it, where as the file handler opens a
-filehandle.
-
-Also note that the file external entity handler will likely choke on
-absolute URIs or file names that don't fit the conventions of the local
-operating system.
-
-The expat base method can be used to set a basename for
-relative pathnames. If no basename is given, or if the basename is itself
-a relative name, then it is relative to the current working directory.
-
-=head2 ExternEntFin (Expat)
-
-This is called after parsing an external entity. It's not called unless
-an ExternEnt handler is also set. There is a default handler installed
-that pairs with the default ExternEnt handler.
-
-If you're going to install your own ExternEnt handler, then you should
-set (or unset) this handler too.
-
-=head2 Entity (Expat, Name, Val, Sysid, Pubid, Ndata, IsParam)
-
-This is called when an entity is declared. For internal entities, the Val
-parameter will contain the value and the remaining three parameters will be
-undefined. For external entities, the Val parameter will be undefined, the
-Sysid parameter will have the system id, the Pubid parameter will have the
-public id if it was provided (it will be undefined otherwise), the Ndata
-parameter will contain the notation for unparsed entities. If this is a
-parameter entity declaration, then the IsParam parameter is true.
-
-Note that this handler and the Unparsed handler above overlap. If both are
-set, then this handler will not be called for unparsed entities.
-
-=head2 Element (Expat, Name, Model)
-
-The element handler is called when an element declaration is found. Name
-is the element name, and Model is the content model as an XML::Parser::Content
-object. See L<XML::Parser::Expat/"XML::Parser::ContentModel Methods">
-for methods available for this class.
-
-=head2 Attlist (Expat, Elname, Attname, Type, Default, Fixed)
-
-This handler is called for each attribute in an ATTLIST declaration.
-So an ATTLIST declaration that has multiple attributes will generate multiple
-calls to this handler. The Elname parameter is the name of the element with
-which the attribute is being associated. The Attname parameter is the name
-of the attribute. Type is the attribute type, given as a string. Default is
-the default value, which will either be "#REQUIRED", "#IMPLIED" or a quoted
-string (i.e. the returned string will begin and end with a quote character).
-If Fixed is true, then this is a fixed attribute.
-
-=head2 Doctype (Expat, Name, Sysid, Pubid, Internal)
-
-This handler is called for DOCTYPE declarations. Name is the document type
-name. Sysid is the system id of the document type, if it was provided,
-otherwise it's undefined. Pubid is the public id of the document type,
-which will be undefined if no public id was given. Internal is the internal
-subset, given as a string. If there was no internal subset, it will be
-undefined. Internal will contain all whitespace, comments, processing
-instructions, and declarations seen in the internal subset. The declarations
-will be there whether or not they have been processed by another handler
-(except for unparsed entities processed by the Unparsed handler). However,
-comments and processing instructions will not appear if they've been processed
-by their respective handlers.
-
-=head2 * DoctypeFin (Parser)
-
-This handler is called after parsing of the DOCTYPE declaration has finished,
-including any internal or external DTD declarations.
-
-=head2 XMLDecl (Expat, Version, Encoding, Standalone)
-
-This handler is called for xml declarations. Version is a string containg
-the version. Encoding is either undefined or contains an encoding string.
-Standalone will be either true, false, or undefined if the standalone attribute
-is yes, no, or not made respectively.
-
-=head1 STYLES
-
-=head2 Debug
-
-This just prints out the document in outline form. Nothing special is
-returned by parse.
-
-=head2 Subs
-
-Each time an element starts, a sub by that name in the package specified
-by the Pkg option is called with the same parameters that the Start
-handler gets called with.
-
-Each time an element ends, a sub with that name appended with an underscore
-("_"), is called with the same parameters that the End handler gets called
-with.
-
-Nothing special is returned by parse.
-
-=head2 Tree
-
-Parse will return a parse tree for the document. Each node in the tree
-takes the form of a tag, content pair. Text nodes are represented with
-a pseudo-tag of "0" and the string that is their content. For elements,
-the content is an array reference. The first item in the array is a
-(possibly empty) hash reference containing attributes. The remainder of
-the array is a sequence of tag-content pairs representing the content
-of the element.
-
-So for example the result of parsing:
-
- <foo><head id="a">Hello <em>there</em></head><bar>Howdy<ref/></bar>do</foo>
-
-would be:
-
- Tag Content
- ==================================================================
- [foo, [{}, head, [{id => "a"}, 0, "Hello ", em, [{}, 0, "there"]],
- bar, [ {}, 0, "Howdy", ref, [{}]],
- 0, "do"
- ]
- ]
-
-The root document "foo", has 3 children: a "head" element, a "bar"
-element and the text "do". After the empty attribute hash, these are
-represented in it's contents by 3 tag-content pairs.
-
-=head2 Objects
-
-This is similar to the Tree style, except that a hash object is created for
-each element. The corresponding object will be in the class whose name
-is created by appending "::" and the element name to the package set with
-the Pkg option. Non-markup text will be in the ::Characters class. The
-contents of the corresponding object will be in an anonymous array that
-is the value of the Kids property for that object.
-
-=head2 Stream
-
-This style also uses the Pkg package. If none of the subs that this
-style looks for is there, then the effect of parsing with this style is
-to print a canonical copy of the document without comments or declarations.
-All the subs receive as their 1st parameter the Expat instance for the
-document they're parsing.
-
-It looks for the following routines:
-
-=over 4
-
-=item * StartDocument
-
-Called at the start of the parse .
-
-=item * StartTag
-
-Called for every start tag with a second parameter of the element type. The $_
-variable will contain a copy of the tag and the %_ variable will contain
-attribute values supplied for that element.
-
-=item * EndTag
-
-Called for every end tag with a second parameter of the element type. The $_
-variable will contain a copy of the end tag.
-
-=item * Text
-
-Called just before start or end tags with accumulated non-markup text in
-the $_ variable.
-
-=item * PI
-
-Called for processing instructions. The $_ variable will contain a copy of
-the PI and the target and data are sent as 2nd and 3rd parameters
-respectively.
-
-=item * EndDocument
-
-Called at conclusion of the parse.
-
-=back
-
-=head1 ENCODINGS
-
-XML documents may be encoded in character sets other than Unicode as
-long as they may be mapped into the Unicode character set. Expat has
-further restrictions on encodings. Read the xmlparse.h header file in
-the expat distribution to see details on these restrictions.
-
-Expat has built-in encodings for: C<UTF-8>, C<ISO-8859-1>, C<UTF-16>, and
-C<US-ASCII>. Encodings are set either through the XML declaration
-encoding attribute or through the ProtocolEncoding option to XML::Parser
-or XML::Parser::Expat.
-
-For encodings other than the built-ins, expat calls the function
-load_encoding in the Expat package with the encoding name. This function
-looks for a file in the path list @XML::Parser::Expat::Encoding_Path, that
-matches the lower-cased name with a '.enc' extension. The first one it
-finds, it loads.
-
-If you wish to build your own encoding maps, check out the XML::Encoding
-module from CPAN.
-
-=head1 AUTHORS
-
-Larry Wall <F<larry@wall.org>> wrote version 1.0.
-
-Clark Cooper <F<coopercc@netheaven.com>> picked up support, changed the API
-for this version (2.x), provided documentation,
-and added some standard package features.
-
-Matt Sergeant <F<matt@sergeant.org>> is now maintaining XML::Parser
-
-=cut
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/Parser/Encodings/Japanese_Encodings.msg b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/Parser/Encodings/Japanese_Encodings.msg
deleted file mode 100644
index 6912e702264..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/Parser/Encodings/Japanese_Encodings.msg
+++ /dev/null
@@ -1,117 +0,0 @@
-Mapping files for Japanese encodings
-
-1998 12/25
-
-Fuji Xerox Information Systems
-MURATA Makoto
-
-1. Overview
-
-This version of XML::Parser and XML::Encoding does not come with map files for
-the charset "Shift_JIS" and the charset "euc-jp". Unfortunately, each of these
-charsets has more than one mapping. None of these mappings are
-considered as authoritative.
-
-Therefore, we have come to believe that it is dangerous to provide map files
-for these charsets. Rather, we introduce several private charsets and map
-files for these private charsets. If IANA, Unicode Consoritum, and JIS
-eventually reach a consensus, we will be able to provide map files for
-"Shift_JIS" and "euc-jp".
-
-2. Different mappings from existing charsets to Unicode
-
-1) Different mappings in JIS X0221 and Unicode
-
-The mapping between JIS X0208:1990 and Unicode 1.1 and the mapping
-between JIS X0212:1990 and Unicode 1.1 are published from Unicode
-consortium. They are available at
-ftp://ftp.unicode.org/Public/MAPPINGS/EASTASIA/JIS/JIS0208.TXT and
-ftp://ftp.unicode.org/Public/MAPPINGS/EASTASIA/JIS/JIS0212.TXT,
-respectively.) These mapping files have a note as below:
-
-# The kanji mappings are a normative part of ISO/IEC 10646. The
-# non-kanji mappings are provisional, pending definition of
-# official mappings by Japanese standards bodies.
-
-Unfortunately, the non-kanji mappings in the Japanese standard for ISO 10646/1,
-namely JIS X 0221:1995, is different from the Unicode Consortium mapping since
-0x213D of JIS X 0208 is mapped to U+2014 (em dash) rather than U+2015
-(horizontal bar). Furthermore, JIS X 0221 clearly says that the mapping is
-informational and non-normative. As a result, some companies (e.g., Microsoft and
-Apple) have introduced slightly different mappings. Therefore, neither the
-Unicode consortium mapping nor the JIS X 0221 mapping are considered as
-authoritative.
-
-2) Shift-JIS
-
-This charset is especially problematic, since its definition has been unclear
-since its inception.
-
-The current registration of the charset "Shift_JIS" is as below:
-
->Name: Shift_JIS (preferred MIME name)
->MIBenum: 17
->Source: A Microsoft code that extends csHalfWidthKatakana to include
-> kanji by adding a second byte when the value of the first
-> byte is in the ranges 81-9F or E0-EF.
->Alias: MS_Kanji
->Alias: csShiftJIS
-
-First, this does not reference to the mapping "Shift-JIS to Unicode"
-published by the Unicode consortium (available at
-ftp://ftp.unicode.org/Public/MAPPINGS/EASTASIA/JIS/SHIFTJIS.TXT).
-
-Second, "kanji" in this registration can be interepreted in different ways.
-Does this "kanji" reference to JIS X0208:1978, JIS X0208:1983, or JIS
-X0208:1990(== JIS X0208:1997)? These three standards are *incompatible* with
-each other. Moreover, we can even argue that "kanji" refers to JIS X0212 or
-ideographic characters in other countries.
-
-Third, each company has extended Shift JIS. For example, Microsoft introduced
-OEM extensions (NEC extensionsand IBM extensions).
-
-Forth, Shift JIS uses JIS X0201, which is almost upper-compatible with US-ASCII
-but is not quite. 5C and 7E of JIS X 0201 are different from backslash and
-tilde, respectively. However, many programming languages (e.g., Java)
-ignore this difference and assumes that 5C and 7E of Shift JIS are backslash
-and tilde.
-
-
-3. Proposed charsets and mappings
-
-As a tentative solution, we introduce two private charsets for EUC-JP and four
-priviate charsets for Shift JIS.
-
-1) EUC-JP
-
-We have two charsets, namely "x-eucjp-unicode" and "x-eucjp-jisx0221". Their
-difference is only one code point. The mapping for the former is based
-on the Unicode Consortium mapping, while the latter is based on the JIS X0221
-mapping.
-
-2) Shift JIS
-
-We have four charsets, namely x-sjis-unicode, x-sjis-jisx0221,
-x-sjis-jdk117, and x-sjis-cp932.
-
-The mapping for the charset x-sjis-unicode is the one published by the Unicode
-consortium. The mapping for x-sjis-jisx0221 is almost equivalent to
-x-sjis-unicode, but 0x213D of JIS X 0208 is mapped to U+2014 (em dash) rather
-than U+2015. The charset x-sjis-jdk117 is again almost equivalent to
-x-sjis-unicode, but 0x5C and 0x7E of JIS X0201 are mapped to backslash and
-tilde.
-
-The charset x-sjis-cp932 is used by Microsoft Windows, and its mapping is
-published from the Unicode Consortium (available at:
-ftp://ftp.unicode.org/Public/MAPPINGS/VENDORS/MICSFT/WINDOWS/CP932.txt). The
-coded character set for this charset includes NEC-extensions and
-IBM-extensions. 0x5C and 0x7E of JIS X0201 are mapped to backslash and tilde;
-0x213D is mapped to U+2015; and 0x2140, 0x2141, 0x2142, and 0x215E of JIS X
-0208 are mapped to compatibility characters.
-
-Makoto
-
-Fuji Xerox Information Systems
-
-Tel: +81-44-812-7230 Fax: +81-44-812-7231
-E-mail: murata@apsdc.ksp.fujixerox.co.jp
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/Parser/Encodings/README b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/Parser/Encodings/README
deleted file mode 100644
index 576323c8225..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/Parser/Encodings/README
+++ /dev/null
@@ -1,51 +0,0 @@
-This directory contains binary encoding maps for some selected encodings.
-If they are placed in a directoy listed in @XML::Parser::Expat::Encoding_Path,
-then they are automaticly loaded by the XML::Parser::Expat::load_encoding
-function as needed. Otherwise you may load what you need directly by
-explicity calling this function.
-
-These maps were generated by a perl script that comes with the module
-XML::Encoding, compile_encoding, from XML formatted encoding maps that
-are distributed with that module. These XML encoding maps were generated
-in turn with a different script, domap, from mapping information contained
-on the Unicode version 2.0 CD-ROM. This CD-ROM comes with the Unicode
-Standard reference manual and can be ordered from the Unicode Consortium
-at http://www.unicode.org. The identical information is available on the
-internet at ftp://ftp.unicode.org/Public/MAPPINGS.
-
-See the encoding.h header in the Expat sub-directory for a description of
-the structure of these files.
-
-Clark Cooper
-December 12, 1998
-
-================================================================
-
-Contributed maps
-
-This distribution contains four contributed encodings from MURATA Makoto
-<murata@apsdc.ksp.fujixerox.co.jp> that are variations on the encoding
-commonly called Shift_JIS:
-
-x-sjis-cp932.enc
-x-sjis-jdk117.enc
-x-sjis-jisx0221.enc
-x-sjis-unicode.enc (This is the same encoding as the shift_jis.enc that
- was distributed with this module in version 2.17)
-
-Please read his message (Japanese_Encodings.msg) about why these are here
-and why I've removed the shift_jis.enc encoding.
-
-We also have two contributed encodings that are variations of the EUC-JP
-encoding from Yoshida Masato <yoshidam@inse.co.jp>:
-
-x-euc-jp-jisx0221.enc
-x-euc-jp-unicode.enc
-
-The comments that MURATA Makoto made in his message apply to these
-encodings too.
-
-KangChan Lee <dolphin@comeng.chungnam.ac.kr> supplied the euc-kr encoding.
-
-Clark Cooper
-December 26, 1998
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/Parser/Encodings/big5.enc b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/Parser/Encodings/big5.enc
deleted file mode 100644
index 94b2bd4bf40..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/Parser/Encodings/big5.enc
+++ /dev/null
Binary files differ
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/Parser/Encodings/euc-kr.enc b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/Parser/Encodings/euc-kr.enc
deleted file mode 100644
index 3da8a13f3c3..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/Parser/Encodings/euc-kr.enc
+++ /dev/null
Binary files differ
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/Parser/Encodings/iso-8859-2.enc b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/Parser/Encodings/iso-8859-2.enc
deleted file mode 100644
index d320d7f8bc9..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/Parser/Encodings/iso-8859-2.enc
+++ /dev/null
Binary files differ
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/Parser/Encodings/iso-8859-3.enc b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/Parser/Encodings/iso-8859-3.enc
deleted file mode 100644
index ba4837852e9..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/Parser/Encodings/iso-8859-3.enc
+++ /dev/null
Binary files differ
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/Parser/Encodings/iso-8859-4.enc b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/Parser/Encodings/iso-8859-4.enc
deleted file mode 100644
index 0294a24089c..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/Parser/Encodings/iso-8859-4.enc
+++ /dev/null
Binary files differ
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/Parser/Encodings/iso-8859-5.enc b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/Parser/Encodings/iso-8859-5.enc
deleted file mode 100644
index 6dbd1692c4b..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/Parser/Encodings/iso-8859-5.enc
+++ /dev/null
Binary files differ
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/Parser/Encodings/iso-8859-7.enc b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/Parser/Encodings/iso-8859-7.enc
deleted file mode 100644
index 02a4aee1c7b..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/Parser/Encodings/iso-8859-7.enc
+++ /dev/null
Binary files differ
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/Parser/Encodings/iso-8859-8.enc b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/Parser/Encodings/iso-8859-8.enc
deleted file mode 100644
index f211bd52342..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/Parser/Encodings/iso-8859-8.enc
+++ /dev/null
Binary files differ
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/Parser/Encodings/iso-8859-9.enc b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/Parser/Encodings/iso-8859-9.enc
deleted file mode 100644
index fdc574b1b98..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/Parser/Encodings/iso-8859-9.enc
+++ /dev/null
Binary files differ
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/Parser/Encodings/windows-1250.enc b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/Parser/Encodings/windows-1250.enc
deleted file mode 100644
index d4a64b55f10..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/Parser/Encodings/windows-1250.enc
+++ /dev/null
Binary files differ
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/Parser/Encodings/windows-1252.enc b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/Parser/Encodings/windows-1252.enc
deleted file mode 100644
index ab2d57c6778..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/Parser/Encodings/windows-1252.enc
+++ /dev/null
Binary files differ
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/Parser/Encodings/x-euc-jp-jisx0221.enc b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/Parser/Encodings/x-euc-jp-jisx0221.enc
deleted file mode 100644
index ca79c07a2bb..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/Parser/Encodings/x-euc-jp-jisx0221.enc
+++ /dev/null
Binary files differ
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/Parser/Encodings/x-euc-jp-unicode.enc b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/Parser/Encodings/x-euc-jp-unicode.enc
deleted file mode 100644
index 34d4d0d31e7..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/Parser/Encodings/x-euc-jp-unicode.enc
+++ /dev/null
Binary files differ
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/Parser/Encodings/x-sjis-cp932.enc b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/Parser/Encodings/x-sjis-cp932.enc
deleted file mode 100644
index c2a6bc40de5..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/Parser/Encodings/x-sjis-cp932.enc
+++ /dev/null
Binary files differ
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/Parser/Encodings/x-sjis-jdk117.enc b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/Parser/Encodings/x-sjis-jdk117.enc
deleted file mode 100644
index b6c2c07c042..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/Parser/Encodings/x-sjis-jdk117.enc
+++ /dev/null
Binary files differ
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/Parser/Encodings/x-sjis-jisx0221.enc b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/Parser/Encodings/x-sjis-jisx0221.enc
deleted file mode 100644
index cbb2db5fbad..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/Parser/Encodings/x-sjis-jisx0221.enc
+++ /dev/null
Binary files differ
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/Parser/Encodings/x-sjis-unicode.enc b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/Parser/Encodings/x-sjis-unicode.enc
deleted file mode 100644
index 6f88a06fd96..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/Parser/Encodings/x-sjis-unicode.enc
+++ /dev/null
Binary files differ
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/Parser/Expat.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/Parser/Expat.pm
deleted file mode 100644
index 9413d80a843..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/Parser/Expat.pm
+++ /dev/null
@@ -1,1230 +0,0 @@
-package XML::Parser::Expat;
-
-require 5.004;
-
-use strict;
-use vars qw($VERSION @ISA %Handler_Setters %Encoding_Table @Encoding_Path
- $have_File_Spec);
-use Carp;
-
-require DynaLoader;
-
-@ISA = qw(DynaLoader);
-$VERSION = "2.36" ;
-
-$have_File_Spec = $INC{'File/Spec.pm'} || do 'File/Spec.pm';
-
-%Encoding_Table = ();
-if ($have_File_Spec) {
- @Encoding_Path = (grep(-d $_,
- map(File::Spec->catdir($_, qw(XML Parser Encodings)),
- @INC)),
- File::Spec->curdir);
-}
-else {
- @Encoding_Path = (grep(-d $_, map($_ . '/XML/Parser/Encodings', @INC)), '.');
-}
-
-
-bootstrap XML::Parser::Expat $VERSION;
-
-%Handler_Setters = (
- Start => \&SetStartElementHandler,
- End => \&SetEndElementHandler,
- Char => \&SetCharacterDataHandler,
- Proc => \&SetProcessingInstructionHandler,
- Comment => \&SetCommentHandler,
- CdataStart => \&SetStartCdataHandler,
- CdataEnd => \&SetEndCdataHandler,
- Default => \&SetDefaultHandler,
- Unparsed => \&SetUnparsedEntityDeclHandler,
- Notation => \&SetNotationDeclHandler,
- ExternEnt => \&SetExternalEntityRefHandler,
- ExternEntFin => \&SetExtEntFinishHandler,
- Entity => \&SetEntityDeclHandler,
- Element => \&SetElementDeclHandler,
- Attlist => \&SetAttListDeclHandler,
- Doctype => \&SetDoctypeHandler,
- DoctypeFin => \&SetEndDoctypeHandler,
- XMLDecl => \&SetXMLDeclHandler
- );
-
-sub new {
- my ($class, %args) = @_;
- my $self = bless \%args, $_[0];
- $args{_State_} = 0;
- $args{Context} = [];
- $args{Namespaces} ||= 0;
- $args{ErrorMessage} ||= '';
- if ($args{Namespaces}) {
- $args{Namespace_Table} = {};
- $args{Namespace_List} = [undef];
- $args{Prefix_Table} = {};
- $args{New_Prefixes} = [];
- }
- $args{_Setters} = \%Handler_Setters;
- $args{Parser} = ParserCreate($self, $args{ProtocolEncoding},
- $args{Namespaces});
- $self;
-}
-
-sub load_encoding {
- my ($file) = @_;
-
- $file =~ s!([^/]+)$!\L$1\E!;
- $file .= '.enc' unless $file =~ /\.enc$/;
- unless ($file =~ m!^/!) {
- foreach (@Encoding_Path) {
- my $tmp = ($have_File_Spec
- ? File::Spec->catfile($_, $file)
- : "$_/$file");
- if (-e $tmp) {
- $file = $tmp;
- last;
- }
- }
- }
-
- local(*ENC);
- open(ENC, $file) or croak("Couldn't open encmap $file:\n$!\n");
- binmode(ENC);
- my $data;
- my $br = sysread(ENC, $data, -s $file);
- croak("Trouble reading $file:\n$!\n")
- unless defined($br);
- close(ENC);
-
- my $name = LoadEncoding($data, $br);
- croak("$file isn't an encmap file")
- unless defined($name);
-
- $name;
-} # End load_encoding
-
-sub setHandlers {
- my ($self, @handler_pairs) = @_;
-
- croak("Uneven number of arguments to setHandlers method")
- if (int(@handler_pairs) & 1);
-
- my @ret;
-
- while (@handler_pairs) {
- my $type = shift @handler_pairs;
- my $handler = shift @handler_pairs;
- croak "Handler for $type not a Code ref"
- unless (! defined($handler) or ! $handler or ref($handler) eq 'CODE');
-
- my $hndl = $self->{_Setters}->{$type};
-
- unless (defined($hndl)) {
- my @types = sort keys %{$self->{_Setters}};
- croak("Unknown Expat handler type: $type\n Valid types: @types");
- }
-
- my $old = &$hndl($self->{Parser}, $handler);
- push (@ret, $type, $old);
- }
-
- return @ret;
-}
-
-sub xpcroak
- {
- my ($self, $message) = @_;
-
- my $eclines = $self->{ErrorContext};
- my $line = GetCurrentLineNumber($_[0]->{Parser});
- $message .= " at line $line";
- $message .= ":\n" . $self->position_in_context($eclines)
- if defined($eclines);
- croak $message;
-}
-
-sub xpcarp {
- my ($self, $message) = @_;
-
- my $eclines = $self->{ErrorContext};
- my $line = GetCurrentLineNumber($_[0]->{Parser});
- $message .= " at line $line";
- $message .= ":\n" . $self->position_in_context($eclines)
- if defined($eclines);
- carp $message;
-}
-
-sub default_current {
- my $self = shift;
- if ($self->{_State_} == 1) {
- return DefaultCurrent($self->{Parser});
- }
-}
-
-sub recognized_string {
- my $self = shift;
- if ($self->{_State_} == 1) {
- return RecognizedString($self->{Parser});
- }
-}
-
-sub original_string {
- my $self = shift;
- if ($self->{_State_} == 1) {
- return OriginalString($self->{Parser});
- }
-}
-
-sub current_line {
- my $self = shift;
- if ($self->{_State_} == 1) {
- return GetCurrentLineNumber($self->{Parser});
- }
-}
-
-sub current_column {
- my $self = shift;
- if ($self->{_State_} == 1) {
- return GetCurrentColumnNumber($self->{Parser});
- }
-}
-
-sub current_byte {
- my $self = shift;
- if ($self->{_State_} == 1) {
- return GetCurrentByteIndex($self->{Parser});
- }
-}
-
-sub base {
- my ($self, $newbase) = @_;
- my $p = $self->{Parser};
- my $oldbase = GetBase($p);
- SetBase($p, $newbase) if @_ > 1;
- return $oldbase;
-}
-
-sub context {
- my $ctx = $_[0]->{Context};
- @$ctx;
-}
-
-sub current_element {
- my ($self) = @_;
- @{$self->{Context}} ? $self->{Context}->[-1] : undef;
-}
-
-sub in_element {
- my ($self, $element) = @_;
- @{$self->{Context}} ? $self->eq_name($self->{Context}->[-1], $element)
- : undef;
-}
-
-sub within_element {
- my ($self, $element) = @_;
- my $cnt = 0;
- foreach (@{$self->{Context}}) {
- $cnt++ if $self->eq_name($_, $element);
- }
- return $cnt;
-}
-
-sub depth {
- my ($self) = @_;
- int(@{$self->{Context}});
-}
-
-sub element_index {
- my ($self) = @_;
-
- if ($self->{_State_} == 1) {
- return ElementIndex($self->{Parser});
- }
-}
-
-################
-# Namespace methods
-
-sub namespace {
- my ($self, $name) = @_;
- local($^W) = 0;
- $self->{Namespace_List}->[int($name)];
-}
-
-sub eq_name {
- my ($self, $nm1, $nm2) = @_;
- local($^W) = 0;
-
- int($nm1) == int($nm2) and $nm1 eq $nm2;
-}
-
-sub generate_ns_name {
- my ($self, $name, $namespace) = @_;
-
- $namespace ?
- GenerateNSName($name, $namespace, $self->{Namespace_Table},
- $self->{Namespace_List})
- : $name;
-}
-
-sub new_ns_prefixes {
- my ($self) = @_;
- if ($self->{Namespaces}) {
- return @{$self->{New_Prefixes}};
- }
- return ();
-}
-
-sub expand_ns_prefix {
- my ($self, $prefix) = @_;
-
- if ($self->{Namespaces}) {
- my $stack = $self->{Prefix_Table}->{$prefix};
- return (defined($stack) and @$stack) ? $stack->[-1] : undef;
- }
-
- return undef;
-}
-
-sub current_ns_prefixes {
- my ($self) = @_;
-
- if ($self->{Namespaces}) {
- my %set = %{$self->{Prefix_Table}};
-
- if (exists $set{'#default'} and not defined($set{'#default'}->[-1])) {
- delete $set{'#default'};
- }
-
- return keys %set;
- }
-
- return ();
-}
-
-
-################################################################
-# Namespace declaration handlers
-#
-
-sub NamespaceStart {
- my ($self, $prefix, $uri) = @_;
-
- $prefix = '#default' unless defined $prefix;
- my $stack = $self->{Prefix_Table}->{$prefix};
-
- if (defined $stack) {
- push(@$stack, $uri);
- }
- else {
- $self->{Prefix_Table}->{$prefix} = [$uri];
- }
-
- # The New_Prefixes list gets emptied at end of startElement function
- # in Expat.xs
-
- push(@{$self->{New_Prefixes}}, $prefix);
-}
-
-sub NamespaceEnd {
- my ($self, $prefix) = @_;
-
- $prefix = '#default' unless defined $prefix;
-
- my $stack = $self->{Prefix_Table}->{$prefix};
- if (@$stack > 1) {
- pop(@$stack);
- }
- else {
- delete $self->{Prefix_Table}->{$prefix};
- }
-}
-
-################
-
-sub specified_attr {
- my $self = shift;
-
- if ($self->{_State_} == 1) {
- return GetSpecifiedAttributeCount($self->{Parser});
- }
-}
-
-sub finish {
- my ($self) = @_;
- if ($self->{_State_} == 1) {
- my $parser = $self->{Parser};
- UnsetAllHandlers($parser);
- }
-}
-
-sub position_in_context {
- my ($self, $lines) = @_;
- if ($self->{_State_} == 1) {
- my $parser = $self->{Parser};
- my ($string, $linepos) = PositionContext($parser, $lines);
-
- return '' unless defined($string);
-
- my $col = GetCurrentColumnNumber($parser);
- my $ptr = ('=' x ($col - 1)) . '^' . "\n";
- my $ret;
- my $dosplit = $linepos < length($string);
-
- $string .= "\n" unless $string =~ /\n$/;
-
- if ($dosplit) {
- $ret = substr($string, 0, $linepos) . $ptr
- . substr($string, $linepos);
- } else {
- $ret = $string . $ptr;
- }
-
- return $ret;
- }
-}
-
-sub xml_escape {
- my $self = shift;
- my $text = shift;
-
- study $text;
- $text =~ s/\&/\&amp;/g;
- $text =~ s/</\&lt;/g;
- foreach (@_) {
- croak "xml_escape: '$_' isn't a single character" if length($_) > 1;
-
- if ($_ eq '>') {
- $text =~ s/>/\&gt;/g;
- }
- elsif ($_ eq '"') {
- $text =~ s/\"/\&quot;/;
- }
- elsif ($_ eq "'") {
- $text =~ s/\'/\&apos;/;
- }
- else {
- my $rep = '&#' . sprintf('x%X', ord($_)) . ';';
- if (/\W/) {
- my $ptrn = "\\$_";
- $text =~ s/$ptrn/$rep/g;
- }
- else {
- $text =~ s/$_/$rep/g;
- }
- }
- }
- $text;
-}
-
-sub skip_until {
- my $self = shift;
- if ($self->{_State_} <= 1) {
- SkipUntil($self->{Parser}, $_[0]);
- }
-}
-
-sub release {
- my $self = shift;
- ParserRelease($self->{Parser});
-}
-
-sub DESTROY {
- my $self = shift;
- ParserFree($self->{Parser});
-}
-
-sub parse {
- my $self = shift;
- my $arg = shift;
- croak "Parse already in progress (Expat)" if $self->{_State_};
- $self->{_State_} = 1;
- my $parser = $self->{Parser};
- my $ioref;
- my $result = 0;
-
- if (defined $arg) {
- if (ref($arg) and UNIVERSAL::isa($arg, 'IO::Handle')) {
- $ioref = $arg;
- } elsif (tied($arg)) {
- my $class = ref($arg);
- no strict 'refs';
- $ioref = $arg if defined &{"${class}::TIEHANDLE"};
- }
- else {
- require IO::Handle;
- eval {
- no strict 'refs';
- $ioref = *{$arg}{IO} if defined *{$arg};
- };
- undef $@;
- }
- }
-
- if (defined($ioref)) {
- my $delim = $self->{Stream_Delimiter};
- my $prev_rs;
-
- $prev_rs = ref($ioref)->input_record_separator("\n$delim\n")
- if defined($delim);
-
- $result = ParseStream($parser, $ioref, $delim);
-
- ref($ioref)->input_record_separator($prev_rs)
- if defined($delim);
- } else {
- $result = ParseString($parser, $arg);
- }
-
- $self->{_State_} = 2;
- $result or croak $self->{ErrorMessage};
-}
-
-sub parsestring {
- my $self = shift;
- $self->parse(@_);
-}
-
-sub parsefile {
- my $self = shift;
- croak "Parser has already been used" if $self->{_State_};
- local(*FILE);
- open(FILE, $_[0]) or croak "Couldn't open $_[0]:\n$!";
- binmode(FILE);
- my $ret = $self->parse(*FILE);
- close(FILE);
- $ret;
-}
-
-################################################################
-package XML::Parser::ContentModel;
-use overload '""' => \&asString, 'eq' => \&thiseq;
-
-sub EMPTY () {1}
-sub ANY () {2}
-sub MIXED () {3}
-sub NAME () {4}
-sub CHOICE () {5}
-sub SEQ () {6}
-
-
-sub isempty {
- return $_[0]->{Type} == EMPTY;
-}
-
-sub isany {
- return $_[0]->{Type} == ANY;
-}
-
-sub ismixed {
- return $_[0]->{Type} == MIXED;
-}
-
-sub isname {
- return $_[0]->{Type} == NAME;
-}
-
-sub name {
- return $_[0]->{Tag};
-}
-
-sub ischoice {
- return $_[0]->{Type} == CHOICE;
-}
-
-sub isseq {
- return $_[0]->{Type} == SEQ;
-}
-
-sub quant {
- return $_[0]->{Quant};
-}
-
-sub children {
- my $children = $_[0]->{Children};
- if (defined $children) {
- return @$children;
- }
- return undef;
-}
-
-sub asString {
- my ($self) = @_;
- my $ret;
-
- if ($self->{Type} == NAME) {
- $ret = $self->{Tag};
- }
- elsif ($self->{Type} == EMPTY) {
- return "EMPTY";
- }
- elsif ($self->{Type} == ANY) {
- return "ANY";
- }
- elsif ($self->{Type} == MIXED) {
- $ret = '(#PCDATA';
- foreach (@{$self->{Children}}) {
- $ret .= '|' . $_;
- }
- $ret .= ')';
- }
- else {
- my $sep = $self->{Type} == CHOICE ? '|' : ',';
- $ret = '(' . join($sep, map { $_->asString } @{$self->{Children}}) . ')';
- }
-
- $ret .= $self->{Quant} if $self->{Quant};
- return $ret;
-}
-
-sub thiseq {
- my $self = shift;
-
- return $self->asString eq $_[0];
-}
-
-################################################################
-package XML::Parser::ExpatNB;
-
-use vars qw(@ISA);
-use Carp;
-
-@ISA = qw(XML::Parser::Expat);
-
-sub parse {
- my $self = shift;
- my $class = ref($self);
- croak "parse method not supported in $class";
-}
-
-sub parsestring {
- my $self = shift;
- my $class = ref($self);
- croak "parsestring method not supported in $class";
-}
-
-sub parsefile {
- my $self = shift;
- my $class = ref($self);
- croak "parsefile method not supported in $class";
-}
-
-sub parse_more {
- my ($self, $data) = @_;
-
- $self->{_State_} = 1;
- my $ret = XML::Parser::Expat::ParsePartial($self->{Parser}, $data);
-
- croak $self->{ErrorMessage} unless $ret;
-}
-
-sub parse_done {
- my $self = shift;
-
- my $ret = XML::Parser::Expat::ParseDone($self->{Parser});
- unless ($ret) {
- my $msg = $self->{ErrorMessage};
- $self->release;
- croak $msg;
- }
-
- $self->{_State_} = 2;
-
- my $result = $ret;
- my @result = ();
- my $final = $self->{FinalHandler};
- if (defined $final) {
- if (wantarray) {
- @result = &$final($self);
- }
- else {
- $result = &$final($self);
- }
- }
-
- $self->release;
-
- return unless defined wantarray;
- return wantarray ? @result : $result;
-}
-
-################################################################
-
-package XML::Parser::Encinfo;
-
-sub DESTROY {
- my $self = shift;
- XML::Parser::Expat::FreeEncoding($self);
-}
-
-1;
-
-__END__
-
-=head1 NAME
-
-XML::Parser::Expat - Lowlevel access to James Clark's expat XML parser
-
-=head1 SYNOPSIS
-
- use XML::Parser::Expat;
-
- $parser = new XML::Parser::Expat;
- $parser->setHandlers('Start' => \&sh,
- 'End' => \&eh,
- 'Char' => \&ch);
- open(FOO, 'info.xml') or die "Couldn't open";
- $parser->parse(*FOO);
- close(FOO);
- # $parser->parse('<foo id="me"> here <em>we</em> go </foo>');
-
- sub sh
- {
- my ($p, $el, %atts) = @_;
- $p->setHandlers('Char' => \&spec)
- if ($el eq 'special');
- ...
- }
-
- sub eh
- {
- my ($p, $el) = @_;
- $p->setHandlers('Char' => \&ch) # Special elements won't contain
- if ($el eq 'special'); # other special elements
- ...
- }
-
-=head1 DESCRIPTION
-
-This module provides an interface to James Clark's XML parser, expat. As in
-expat, a single instance of the parser can only parse one document. Calls
-to parsestring after the first for a given instance will die.
-
-Expat (and XML::Parser::Expat) are event based. As the parser recognizes
-parts of the document (say the start or end of an XML element), then any
-handlers registered for that type of an event are called with suitable
-parameters.
-
-=head1 METHODS
-
-=over 4
-
-=item new
-
-This is a class method, the constructor for XML::Parser::Expat. Options are
-passed as keyword value pairs. The recognized options are:
-
-=over 4
-
-=item * ProtocolEncoding
-
-The protocol encoding name. The default is none. The expat built-in
-encodings are: C<UTF-8>, C<ISO-8859-1>, C<UTF-16>, and C<US-ASCII>.
-Other encodings may be used if they have encoding maps in one of the
-directories in the @Encoding_Path list. Setting the protocol encoding
-overrides any encoding in the XML declaration.
-
-=item * Namespaces
-
-When this option is given with a true value, then the parser does namespace
-processing. By default, namespace processing is turned off. When it is
-turned on, the parser consumes I<xmlns> attributes and strips off prefixes
-from element and attributes names where those prefixes have a defined
-namespace. A name's namespace can be found using the L<"namespace"> method
-and two names can be checked for absolute equality with the L<"eq_name">
-method.
-
-=item * NoExpand
-
-Normally, the parser will try to expand references to entities defined in
-the internal subset. If this option is set to a true value, and a default
-handler is also set, then the default handler will be called when an
-entity reference is seen in text. This has no effect if a default handler
-has not been registered, and it has no effect on the expansion of entity
-references inside attribute values.
-
-=item * Stream_Delimiter
-
-This option takes a string value. When this string is found alone on a line
-while parsing from a stream, then the parse is ended as if it saw an end of
-file. The intended use is with a stream of xml documents in a MIME multipart
-format. The string should not contain a trailing newline.
-
-=item * ErrorContext
-
-When this option is defined, errors are reported in context. The value
-of ErrorContext should be the number of lines to show on either side of
-the line in which the error occurred.
-
-=item * ParseParamEnt
-
-Unless standalone is set to "yes" in the XML declaration, setting this to
-a true value allows the external DTD to be read, and parameter entities
-to be parsed and expanded.
-
-=item * Base
-
-The base to use for relative pathnames or URLs. This can also be done by
-using the base method.
-
-=back
-
-=item setHandlers(TYPE, HANDLER [, TYPE, HANDLER [...]])
-
-This method registers handlers for the various events. If no handlers are
-registered, then a call to parsestring or parsefile will only determine if
-the corresponding XML document is well formed (by returning without error.)
-This may be called from within a handler, after the parse has started.
-
-Setting a handler to something that evaluates to false unsets that
-handler.
-
-This method returns a list of type, handler pairs corresponding to the
-input. The handlers returned are the ones that were in effect before the
-call to setHandlers.
-
-The recognized events and the parameters passed to the corresponding
-handlers are:
-
-=over 4
-
-=item * Start (Parser, Element [, Attr, Val [,...]])
-
-This event is generated when an XML start tag is recognized. Parser is
-an XML::Parser::Expat instance. Element is the name of the XML element that
-is opened with the start tag. The Attr & Val pairs are generated for each
-attribute in the start tag.
-
-=item * End (Parser, Element)
-
-This event is generated when an XML end tag is recognized. Note that
-an XML empty tag (<foo/>) generates both a start and an end event.
-
-There is always a lower level start and end handler installed that wrap
-the corresponding callbacks. This is to handle the context mechanism.
-A consequence of this is that the default handler (see below) will not
-see a start tag or end tag unless the default_current method is called.
-
-=item * Char (Parser, String)
-
-This event is generated when non-markup is recognized. The non-markup
-sequence of characters is in String. A single non-markup sequence of
-characters may generate multiple calls to this handler. Whatever the
-encoding of the string in the original document, this is given to the
-handler in UTF-8.
-
-=item * Proc (Parser, Target, Data)
-
-This event is generated when a processing instruction is recognized.
-
-=item * Comment (Parser, String)
-
-This event is generated when a comment is recognized.
-
-=item * CdataStart (Parser)
-
-This is called at the start of a CDATA section.
-
-=item * CdataEnd (Parser)
-
-This is called at the end of a CDATA section.
-
-=item * Default (Parser, String)
-
-This is called for any characters that don't have a registered handler.
-This includes both characters that are part of markup for which no
-events are generated (markup declarations) and characters that
-could generate events, but for which no handler has been registered.
-
-Whatever the encoding in the original document, the string is returned to
-the handler in UTF-8.
-
-=item * Unparsed (Parser, Entity, Base, Sysid, Pubid, Notation)
-
-This is called for a declaration of an unparsed entity. Entity is the name
-of the entity. Base is the base to be used for resolving a relative URI.
-Sysid is the system id. Pubid is the public id. Notation is the notation
-name. Base and Pubid may be undefined.
-
-=item * Notation (Parser, Notation, Base, Sysid, Pubid)
-
-This is called for a declaration of notation. Notation is the notation name.
-Base is the base to be used for resolving a relative URI. Sysid is the system
-id. Pubid is the public id. Base, Sysid, and Pubid may all be undefined.
-
-=item * ExternEnt (Parser, Base, Sysid, Pubid)
-
-This is called when an external entity is referenced. Base is the base to be
-used for resolving a relative URI. Sysid is the system id. Pubid is the public
-id. Base, and Pubid may be undefined.
-
-This handler should either return a string, which represents the contents of
-the external entity, or return an open filehandle that can be read to obtain
-the contents of the external entity, or return undef, which indicates the
-external entity couldn't be found and will generate a parse error.
-
-If an open filehandle is returned, it must be returned as either a glob
-(*FOO) or as a reference to a glob (e.g. an instance of IO::Handle).
-
-=item * ExternEntFin (Parser)
-
-This is called after an external entity has been parsed. It allows
-applications to perform cleanup on actions performed in the above
-ExternEnt handler.
-
-=item * Entity (Parser, Name, Val, Sysid, Pubid, Ndata, IsParam)
-
-This is called when an entity is declared. For internal entities, the Val
-parameter will contain the value and the remaining three parameters will
-be undefined. For external entities, the Val parameter
-will be undefined, the Sysid parameter will have the system id, the Pubid
-parameter will have the public id if it was provided (it will be undefined
-otherwise), the Ndata parameter will contain the notation for unparsed
-entities. If this is a parameter entity declaration, then the IsParam
-parameter is true.
-
-Note that this handler and the Unparsed handler above overlap. If both are
-set, then this handler will not be called for unparsed entities.
-
-=item * Element (Parser, Name, Model)
-
-The element handler is called when an element declaration is found. Name is
-the element name, and Model is the content model as an
-XML::Parser::ContentModel object. See L<"XML::Parser::ContentModel Methods">
-for methods available for this class.
-
-=item * Attlist (Parser, Elname, Attname, Type, Default, Fixed)
-
-This handler is called for each attribute in an ATTLIST declaration.
-So an ATTLIST declaration that has multiple attributes
-will generate multiple calls to this handler. The Elname parameter is the
-name of the element with which the attribute is being associated. The Attname
-parameter is the name of the attribute. Type is the attribute type, given as
-a string. Default is the default value, which will either be "#REQUIRED",
-"#IMPLIED" or a quoted string (i.e. the returned string will begin and end
-with a quote character). If Fixed is true, then this is a fixed attribute.
-
-=item * Doctype (Parser, Name, Sysid, Pubid, Internal)
-
-This handler is called for DOCTYPE declarations. Name is the document type
-name. Sysid is the system id of the document type, if it was provided,
-otherwise it's undefined. Pubid is the public id of the document type,
-which will be undefined if no public id was given. Internal will be
-true or false, indicating whether or not the doctype declaration contains
-an internal subset.
-
-=item * DoctypeFin (Parser)
-
-This handler is called after parsing of the DOCTYPE declaration has finished,
-including any internal or external DTD declarations.
-
-=item * XMLDecl (Parser, Version, Encoding, Standalone)
-
-This handler is called for XML declarations. Version is a string containg
-the version. Encoding is either undefined or contains an encoding string.
-Standalone is either undefined, or true or false. Undefined indicates
-that no standalone parameter was given in the XML declaration. True or
-false indicates "yes" or "no" respectively.
-
-=back
-
-=item namespace(name)
-
-Return the URI of the namespace that the name belongs to. If the name doesn't
-belong to any namespace, an undef is returned. This is only valid on names
-received through the Start or End handlers from a single document, or through
-a call to the generate_ns_name method. In other words, don't use names
-generated from one instance of XML::Parser::Expat with other instances.
-
-=item eq_name(name1, name2)
-
-Return true if name1 and name2 are identical (i.e. same name and from
-the same namespace.) This is only meaningful if both names were obtained
-through the Start or End handlers from a single document, or through
-a call to the generate_ns_name method.
-
-=item generate_ns_name(name, namespace)
-
-Return a name, associated with a given namespace, good for using with the
-above 2 methods. The namespace argument should be the namespace URI, not
-a prefix.
-
-=item new_ns_prefixes
-
-When called from a start tag handler, returns namespace prefixes declared
-with this start tag. If called elsewere (or if there were no namespace
-prefixes declared), it returns an empty list. Setting of the default
-namespace is indicated with '#default' as a prefix.
-
-=item expand_ns_prefix(prefix)
-
-Return the uri to which the given prefix is currently bound. Returns
-undef if the prefix isn't currently bound. Use '#default' to find the
-current binding of the default namespace (if any).
-
-=item current_ns_prefixes
-
-Return a list of currently bound namespace prefixes. The order of the
-the prefixes in the list has no meaning. If the default namespace is
-currently bound, '#default' appears in the list.
-
-=item recognized_string
-
-Returns the string from the document that was recognized in order to call
-the current handler. For instance, when called from a start handler, it
-will give us the the start-tag string. The string is encoded in UTF-8.
-This method doesn't return a meaningful string inside declaration handlers.
-
-=item original_string
-
-Returns the verbatim string from the document that was recognized in
-order to call the current handler. The string is in the original document
-encoding. This method doesn't return a meaningful string inside declaration
-handlers.
-
-=item default_current
-
-When called from a handler, causes the sequence of characters that generated
-the corresponding event to be sent to the default handler (if one is
-registered). Use of this method is deprecated in favor the recognized_string
-method, which you can use without installing a default handler. This
-method doesn't deliver a meaningful string to the default handler when
-called from inside declaration handlers.
-
-=item xpcroak(message)
-
-Concatenate onto the given message the current line number within the
-XML document plus the message implied by ErrorContext. Then croak with
-the formed message.
-
-=item xpcarp(message)
-
-Concatenate onto the given message the current line number within the
-XML document plus the message implied by ErrorContext. Then carp with
-the formed message.
-
-=item current_line
-
-Returns the line number of the current position of the parse.
-
-=item current_column
-
-Returns the column number of the current position of the parse.
-
-=item current_byte
-
-Returns the current position of the parse.
-
-=item base([NEWBASE]);
-
-Returns the current value of the base for resolving relative URIs. If
-NEWBASE is supplied, changes the base to that value.
-
-=item context
-
-Returns a list of element names that represent open elements, with the
-last one being the innermost. Inside start and end tag handlers, this
-will be the tag of the parent element.
-
-=item current_element
-
-Returns the name of the innermost currently opened element. Inside
-start or end handlers, returns the parent of the element associated
-with those tags.
-
-=item in_element(NAME)
-
-Returns true if NAME is equal to the name of the innermost currently opened
-element. If namespace processing is being used and you want to check
-against a name that may be in a namespace, then use the generate_ns_name
-method to create the NAME argument.
-
-=item within_element(NAME)
-
-Returns the number of times the given name appears in the context list.
-If namespace processing is being used and you want to check
-against a name that may be in a namespace, then use the generate_ns_name
-method to create the NAME argument.
-
-=item depth
-
-Returns the size of the context list.
-
-=item element_index
-
-Returns an integer that is the depth-first visit order of the current
-element. This will be zero outside of the root element. For example,
-this will return 1 when called from the start handler for the root element
-start tag.
-
-=item skip_until(INDEX)
-
-INDEX is an integer that represents an element index. When this method
-is called, all handlers are suspended until the start tag for an element
-that has an index number equal to INDEX is seen. If a start handler has
-been set, then this is the first tag that the start handler will see
-after skip_until has been called.
-
-
-=item position_in_context(LINES)
-
-Returns a string that shows the current parse position. LINES should be
-an integer >= 0 that represents the number of lines on either side of the
-current parse line to place into the returned string.
-
-=item xml_escape(TEXT [, CHAR [, CHAR ...]])
-
-Returns TEXT with markup characters turned into character entities. Any
-additional characters provided as arguments are also turned into character
-references where found in TEXT.
-
-=item parse (SOURCE)
-
-The SOURCE parameter should either be a string containing the whole XML
-document, or it should be an open IO::Handle. Only a single document
-may be parsed for a given instance of XML::Parser::Expat, so this will croak
-if it's been called previously for this instance.
-
-=item parsestring(XML_DOC_STRING)
-
-Parses the given string as an XML document. Only a single document may be
-parsed for a given instance of XML::Parser::Expat, so this will die if either
-parsestring or parsefile has been called for this instance previously.
-
-This method is deprecated in favor of the parse method.
-
-=item parsefile(FILENAME)
-
-Parses the XML document in the given file. Will die if parsestring or
-parsefile has been called previously for this instance.
-
-=item is_defaulted(ATTNAME)
-
-NO LONGER WORKS. To find out if an attribute is defaulted please use
-the specified_attr method.
-
-=item specified_attr
-
-When the start handler receives lists of attributes and values, the
-non-defaulted (i.e. explicitly specified) attributes occur in the list
-first. This method returns the number of specified items in the list.
-So if this number is equal to the length of the list, there were no
-defaulted values. Otherwise the number points to the index of the
-first defaulted attribute name.
-
-=item finish
-
-Unsets all handlers (including internal ones that set context), but expat
-continues parsing to the end of the document or until it finds an error.
-It should finish up a lot faster than with the handlers set.
-
-=item release
-
-There are data structures used by XML::Parser::Expat that have circular
-references. This means that these structures will never be garbage
-collected unless these references are explicitly broken. Calling this
-method breaks those references (and makes the instance unusable.)
-
-Normally, higher level calls handle this for you, but if you are using
-XML::Parser::Expat directly, then it's your responsibility to call it.
-
-=back
-
-=head2 XML::Parser::ContentModel Methods
-
-The element declaration handlers are passed objects of this class as the
-content model of the element declaration. They also represent content
-particles, components of a content model.
-
-When referred to as a string, these objects are automagicly converted to a
-string representation of the model (or content particle).
-
-=over 4
-
-=item isempty
-
-This method returns true if the object is "EMPTY", false otherwise.
-
-=item isany
-
-This method returns true if the object is "ANY", false otherwise.
-
-=item ismixed
-
-This method returns true if the object is "(#PCDATA)" or "(#PCDATA|...)*",
-false otherwise.
-
-=item isname
-
-This method returns if the object is an element name.
-
-=item ischoice
-
-This method returns true if the object is a choice of content particles.
-
-
-=item isseq
-
-This method returns true if the object is a sequence of content particles.
-
-=item quant
-
-This method returns undef or a string representing the quantifier
-('?', '*', '+') associated with the model or particle.
-
-=item children
-
-This method returns undef or (for mixed, choice, and sequence types)
-an array of component content particles. There will always be at least
-one component for choices and sequences, but for a mixed content model
-of pure PCDATA, "(#PCDATA)", then an undef is returned.
-
-=back
-
-=head2 XML::Parser::ExpatNB Methods
-
-The class XML::Parser::ExpatNB is a subclass of XML::Parser::Expat used
-for non-blocking access to the expat library. It does not support the parse,
-parsestring, or parsefile methods, but it does have these additional methods:
-
-=over 4
-
-=item parse_more(DATA)
-
-Feed expat more text to munch on.
-
-=item parse_done
-
-Tell expat that it's gotten the whole document.
-
-=back
-
-=head1 FUNCTIONS
-
-=over 4
-
-=item XML::Parser::Expat::load_encoding(ENCODING)
-
-Load an external encoding. ENCODING is either the name of an encoding or
-the name of a file. The basename is converted to lowercase and a '.enc'
-extension is appended unless there's one already there. Then, unless
-it's an absolute pathname (i.e. begins with '/'), the first file by that
-name discovered in the @Encoding_Path path list is used.
-
-The encoding in the file is loaded and kept in the %Encoding_Table
-table. Earlier encodings of the same name are replaced.
-
-This function is automaticly called by expat when it encounters an encoding
-it doesn't know about. Expat shouldn't call this twice for the same
-encoding name. The only reason users should use this function is to
-explicitly load an encoding not contained in the @Encoding_Path list.
-
-=back
-
-=head1 AUTHORS
-
-Larry Wall <F<larry@wall.org>> wrote version 1.0.
-
-Clark Cooper <F<coopercc@netheaven.com>> picked up support, changed the API
-for this version (2.x), provided documentation, and added some standard
-package features.
-
-=cut
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/Parser/LWPExternEnt.pl b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/Parser/LWPExternEnt.pl
deleted file mode 100644
index d0c940b1ac5..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/Parser/LWPExternEnt.pl
+++ /dev/null
@@ -1,71 +0,0 @@
-# LWPExternEnt.pl
-#
-# Copyright (c) 2000 Clark Cooper
-# All rights reserved.
-#
-# This program is free software; you can redistribute it and/or
-# modify it under the same terms as Perl itself.
-
-package XML::Parser;
-
-use URI;
-use URI::file;
-use LWP;
-
-##
-## Note that this external entity handler reads the entire entity into
-## memory, so it will choke on huge ones. It would be really nice if
-## LWP::UserAgent optionally returned us an IO::Handle.
-##
-
-sub lwp_ext_ent_handler {
- my ($xp, $base, $sys) = @_; # We don't use public id
-
- my $uri;
-
- if (defined $base) {
- # Base may have been set by parsefile, which is agnostic about
- # whether its a file or URI.
- my $base_uri = new URI($base);
- unless (defined $base_uri->scheme) {
- $base_uri = URI->new_abs($base_uri, URI::file->cwd);
- }
-
- $uri = URI->new_abs($sys, $base_uri);
- }
- else {
- $uri = new URI($sys);
- unless (defined $uri->scheme) {
- $uri = URI->new_abs($uri, URI::file->cwd);
- }
- }
-
- my $ua = $xp->{_lwpagent};
- unless (defined $ua) {
- $ua = $xp->{_lwpagent} = new LWP::UserAgent();
- $ua->env_proxy();
- }
-
- my $req = new HTTP::Request('GET', $uri);
-
- my $res = $ua->request($req);
- if ($res->is_error) {
- $xp->{ErrorMessage} .= "\n" . $res->status_line . " $uri";
- return undef;
- }
-
- $xp->{_BaseStack} ||= [];
- push(@{$xp->{_BaseStack}}, $base);
-
- $xp->base($uri);
-
- return $res->content;
-} # End lwp_ext_ent_handler
-
-sub lwp_ext_ent_cleanup {
- my ($xp) = @_;
-
- $xp->base(pop(@{$xp->{_BaseStack}}));
-} # End lwp_ext_ent_cleanup
-
-1;
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/Parser/Style/Debug.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/Parser/Style/Debug.pm
deleted file mode 100644
index 89fcd8b248b..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/Parser/Style/Debug.pm
+++ /dev/null
@@ -1,52 +0,0 @@
-# $Id: Debug.pm,v 1.1 2003/07/27 16:07:49 matt Exp $
-
-package XML::Parser::Style::Debug;
-use strict;
-
-sub Start {
- my $expat = shift;
- my $tag = shift;
- print STDERR "@{$expat->{Context}} \\\\ (@_)\n";
-}
-
-sub End {
- my $expat = shift;
- my $tag = shift;
- print STDERR "@{$expat->{Context}} //\n";
-}
-
-sub Char {
- my $expat = shift;
- my $text = shift;
- $text =~ s/([\x80-\xff])/sprintf "#x%X;", ord $1/eg;
- $text =~ s/([\t\n])/sprintf "#%d;", ord $1/eg;
- print STDERR "@{$expat->{Context}} || $text\n";
-}
-
-sub Proc {
- my $expat = shift;
- my $target = shift;
- my $text = shift;
- my @foo = @{$expat->{Context}};
- print STDERR "@foo $target($text)\n";
-}
-
-1;
-__END__
-
-=head1 NAME
-
-XML::Parser::Style::Debug - Debug style for XML::Parser
-
-=head1 SYNOPSIS
-
- use XML::Parser;
- my $p = XML::Parser->new(Style => 'Debug');
- $p->parsefile('foo.xml');
-
-=head1 DESCRIPTION
-
-This just prints out the document in outline form to STDERR. Nothing special is
-returned by parse.
-
-=cut \ No newline at end of file
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/Parser/Style/Objects.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/Parser/Style/Objects.pm
deleted file mode 100644
index 8603db05a39..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/Parser/Style/Objects.pm
+++ /dev/null
@@ -1,78 +0,0 @@
-# $Id: Objects.pm,v 1.1 2003/08/18 20:20:51 matt Exp $
-
-package XML::Parser::Style::Objects;
-use strict;
-
-sub Init {
- my $expat = shift;
- $expat->{Lists} = [];
- $expat->{Curlist} = $expat->{Tree} = [];
-}
-
-sub Start {
- my $expat = shift;
- my $tag = shift;
- my $newlist = [ ];
- my $class = "${$expat}{Pkg}::$tag";
- my $newobj = bless { @_, Kids => $newlist }, $class;
- push @{ $expat->{Lists} }, $expat->{Curlist};
- push @{ $expat->{Curlist} }, $newobj;
- $expat->{Curlist} = $newlist;
-}
-
-sub End {
- my $expat = shift;
- my $tag = shift;
- $expat->{Curlist} = pop @{ $expat->{Lists} };
-}
-
-sub Char {
- my $expat = shift;
- my $text = shift;
- my $class = "${$expat}{Pkg}::Characters";
- my $clist = $expat->{Curlist};
- my $pos = $#$clist;
-
- if ($pos >= 0 and ref($clist->[$pos]) eq $class) {
- $clist->[$pos]->{Text} .= $text;
- } else {
- push @$clist, bless { Text => $text }, $class;
- }
-}
-
-sub Final {
- my $expat = shift;
- delete $expat->{Curlist};
- delete $expat->{Lists};
- $expat->{Tree};
-}
-
-1;
-__END__
-
-=head1 NAME
-
-XML::Parser::Style::Objects
-
-=head1 SYNOPSIS
-
- use XML::Parser;
- my $p = XML::Parser->new(Style => 'Objects', Pkg => 'MyNode');
- my $tree = $p->parsefile('foo.xml');
-
-=head1 DESCRIPTION
-
-This module implements XML::Parser's Objects style parser.
-
-This is similar to the Tree style, except that a hash object is created for
-each element. The corresponding object will be in the class whose name
-is created by appending "::" and the element name to the package set with
-the Pkg option. Non-markup text will be in the ::Characters class. The
-contents of the corresponding object will be in an anonymous array that
-is the value of the Kids property for that object.
-
-=head1 SEE ALSO
-
-L<XML::Parser::Style::Tree>
-
-=cut \ No newline at end of file
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/Parser/Style/Stream.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/Parser/Style/Stream.pm
deleted file mode 100644
index 1e2e3f7183d..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/Parser/Style/Stream.pm
+++ /dev/null
@@ -1,184 +0,0 @@
-# $Id: Stream.pm,v 1.1 2003/07/27 16:07:49 matt Exp $
-
-package XML::Parser::Style::Stream;
-use strict;
-
-# This style invented by Tim Bray <tbray@textuality.com>
-
-sub Init {
- no strict 'refs';
- my $expat = shift;
- $expat->{Text} = '';
- my $sub = $expat->{Pkg} ."::StartDocument";
- &$sub($expat)
- if defined(&$sub);
-}
-
-sub Start {
- no strict 'refs';
- my $expat = shift;
- my $type = shift;
-
- doText($expat);
- $_ = "<$type";
-
- %_ = @_;
- while (@_) {
- $_ .= ' ' . shift() . '="' . shift() . '"';
- }
- $_ .= '>';
-
- my $sub = $expat->{Pkg} . "::StartTag";
- if (defined(&$sub)) {
- &$sub($expat, $type);
- } else {
- print;
- }
-}
-
-sub End {
- no strict 'refs';
- my $expat = shift;
- my $type = shift;
-
- # Set right context for Text handler
- push(@{$expat->{Context}}, $type);
- doText($expat);
- pop(@{$expat->{Context}});
-
- $_ = "</$type>";
-
- my $sub = $expat->{Pkg} . "::EndTag";
- if (defined(&$sub)) {
- &$sub($expat, $type);
- } else {
- print;
- }
-}
-
-sub Char {
- my $expat = shift;
- $expat->{Text} .= shift;
-}
-
-sub Proc {
- no strict 'refs';
- my $expat = shift;
- my $target = shift;
- my $text = shift;
-
- doText($expat);
-
- $_ = "<?$target $text?>";
-
- my $sub = $expat->{Pkg} . "::PI";
- if (defined(&$sub)) {
- &$sub($expat, $target, $text);
- } else {
- print;
- }
-}
-
-sub Final {
- no strict 'refs';
- my $expat = shift;
- my $sub = $expat->{Pkg} . "::EndDocument";
- &$sub($expat)
- if defined(&$sub);
-}
-
-sub doText {
- no strict 'refs';
- my $expat = shift;
- $_ = $expat->{Text};
-
- if (length($_)) {
- my $sub = $expat->{Pkg} . "::Text";
- if (defined(&$sub)) {
- &$sub($expat);
- } else {
- print;
- }
-
- $expat->{Text} = '';
- }
-}
-
-1;
-__END__
-
-=head1 NAME
-
-XML::Parser::Style::Stream - Stream style for XML::Parser
-
-=head1 SYNOPSIS
-
- use XML::Parser;
- my $p = XML::Parser->new(Style => 'Stream', Pkg => 'MySubs');
- $p->parsefile('foo.xml');
-
- {
- package MySubs;
-
- sub StartTag {
- my ($e, $name) = @_;
- # do something with start tags
- }
-
- sub EndTag {
- my ($e, $name) = @_;
- # do something with end tags
- }
-
- sub Characters {
- my ($e, $data) = @_;
- # do something with text nodes
- }
- }
-
-=head1 DESCRIPTION
-
-This style uses the Pkg option to find subs in a given package to call for each event.
-If none of the subs that this
-style looks for is there, then the effect of parsing with this style is
-to print a canonical copy of the document without comments or declarations.
-All the subs receive as their 1st parameter the Expat instance for the
-document they're parsing.
-
-It looks for the following routines:
-
-=over 4
-
-=item * StartDocument
-
-Called at the start of the parse .
-
-=item * StartTag
-
-Called for every start tag with a second parameter of the element type. The $_
-variable will contain a copy of the tag and the %_ variable will contain
-attribute values supplied for that element.
-
-=item * EndTag
-
-Called for every end tag with a second parameter of the element type. The $_
-variable will contain a copy of the end tag.
-
-=item * Text
-
-Called just before start or end tags with accumulated non-markup text in
-the $_ variable.
-
-=item * PI
-
-Called for processing instructions. The $_ variable will contain a copy of
-the PI and the target and data are sent as 2nd and 3rd parameters
-respectively.
-
-=item * EndDocument
-
-Called at conclusion of the parse.
-
-=back
-
-=cut \ No newline at end of file
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/Parser/Style/Subs.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/Parser/Style/Subs.pm
deleted file mode 100644
index 15a21439e8e..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/Parser/Style/Subs.pm
+++ /dev/null
@@ -1,58 +0,0 @@
-# $Id: Subs.pm,v 1.1 2003/07/27 16:07:49 matt Exp $
-
-package XML::Parser::Style::Subs;
-
-sub Start {
- no strict 'refs';
- my $expat = shift;
- my $tag = shift;
- my $sub = $expat->{Pkg} . "::$tag";
- eval { &$sub($expat, $tag, @_) };
-}
-
-sub End {
- no strict 'refs';
- my $expat = shift;
- my $tag = shift;
- my $sub = $expat->{Pkg} . "::${tag}_";
- eval { &$sub($expat, $tag) };
-}
-
-1;
-__END__
-
-=head1 NAME
-
-XML::Parser::Style::Subs
-
-=head1 SYNOPSIS
-
- use XML::Parser;
- my $p = XML::Parser->new(Style => 'Subs', Pkg => 'MySubs');
- $p->parsefile('foo.xml');
-
- {
- package MySubs;
-
- sub foo {
- # start of foo tag
- }
-
- sub foo_ {
- # end of foo tag
- }
- }
-
-=head1 DESCRIPTION
-
-Each time an element starts, a sub by that name in the package specified
-by the Pkg option is called with the same parameters that the Start
-handler gets called with.
-
-Each time an element ends, a sub with that name appended with an underscore
-("_"), is called with the same parameters that the End handler gets called
-with.
-
-Nothing special is returned by parse.
-
-=cut \ No newline at end of file
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/Parser/Style/Tree.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/Parser/Style/Tree.pm
deleted file mode 100644
index c0e69f131ce..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/Parser/Style/Tree.pm
+++ /dev/null
@@ -1,90 +0,0 @@
-# $Id: Tree.pm,v 1.2 2003/07/31 07:54:51 matt Exp $
-
-package XML::Parser::Style::Tree;
-$XML::Parser::Built_In_Styles{Tree} = 1;
-
-sub Init {
- my $expat = shift;
- $expat->{Lists} = [];
- $expat->{Curlist} = $expat->{Tree} = [];
-}
-
-sub Start {
- my $expat = shift;
- my $tag = shift;
- my $newlist = [ { @_ } ];
- push @{ $expat->{Lists} }, $expat->{Curlist};
- push @{ $expat->{Curlist} }, $tag => $newlist;
- $expat->{Curlist} = $newlist;
-}
-
-sub End {
- my $expat = shift;
- my $tag = shift;
- $expat->{Curlist} = pop @{ $expat->{Lists} };
-}
-
-sub Char {
- my $expat = shift;
- my $text = shift;
- my $clist = $expat->{Curlist};
- my $pos = $#$clist;
-
- if ($pos > 0 and $clist->[$pos - 1] eq '0') {
- $clist->[$pos] .= $text;
- } else {
- push @$clist, 0 => $text;
- }
-}
-
-sub Final {
- my $expat = shift;
- delete $expat->{Curlist};
- delete $expat->{Lists};
- $expat->{Tree};
-}
-
-1;
-__END__
-
-=head1 NAME
-
-XML::Parser::Style::Tree
-
-=head1 SYNOPSIS
-
- use XML::Parser;
- my $p = XML::Parser->new(Style => 'Tree');
- my $tree = $p->parsefile('foo.xml');
-
-=head1 DESCRIPTION
-
-This module implements XML::Parser's Tree style parser.
-
-When parsing a document, C<parse()> will return a parse tree for the
-document. Each node in the tree
-takes the form of a tag, content pair. Text nodes are represented with
-a pseudo-tag of "0" and the string that is their content. For elements,
-the content is an array reference. The first item in the array is a
-(possibly empty) hash reference containing attributes. The remainder of
-the array is a sequence of tag-content pairs representing the content
-of the element.
-
-So for example the result of parsing:
-
- <foo><head id="a">Hello <em>there</em></head><bar>Howdy<ref/></bar>do</foo>
-
-would be:
- Tag Content
- ==================================================================
- [foo, [{}, head, [{id => "a"}, 0, "Hello ", em, [{}, 0, "there"]],
- bar, [ {}, 0, "Howdy", ref, [{}]],
- 0, "do"
- ]
- ]
-
-The root document "foo", has 3 children: a "head" element, a "bar"
-element and the text "do". After the empty attribute hash, these are
-represented in it's contents by 3 tag-content pairs.
-
-=cut
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Alias/.packlist b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Alias/.packlist
deleted file mode 100644
index cc4b4bb6f51..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Alias/.packlist
+++ /dev/null
@@ -1,2 +0,0 @@
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/Alias.pm
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Alias/Alias.dll
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Alias/Alias.dll b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Alias/Alias.dll
deleted file mode 100755
index 941eba62d8d..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Alias/Alias.dll
+++ /dev/null
Binary files differ
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Archive/Zip/.packlist b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Archive/Zip/.packlist
deleted file mode 100644
index 5fa52914d08..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Archive/Zip/.packlist
+++ /dev/null
@@ -1,14 +0,0 @@
-/usr/bin/crc32
-/usr/lib/perl5/vendor_perl/5.10/Archive/Zip.pm
-/usr/lib/perl5/vendor_perl/5.10/Archive/Zip/Archive.pm
-/usr/lib/perl5/vendor_perl/5.10/Archive/Zip/BufferedFileHandle.pm
-/usr/lib/perl5/vendor_perl/5.10/Archive/Zip/DirectoryMember.pm
-/usr/lib/perl5/vendor_perl/5.10/Archive/Zip/FAQ.pod
-/usr/lib/perl5/vendor_perl/5.10/Archive/Zip/FileMember.pm
-/usr/lib/perl5/vendor_perl/5.10/Archive/Zip/Member.pm
-/usr/lib/perl5/vendor_perl/5.10/Archive/Zip/MemberRead.pm
-/usr/lib/perl5/vendor_perl/5.10/Archive/Zip/MockFileHandle.pm
-/usr/lib/perl5/vendor_perl/5.10/Archive/Zip/NewFileMember.pm
-/usr/lib/perl5/vendor_perl/5.10/Archive/Zip/StringMember.pm
-/usr/lib/perl5/vendor_perl/5.10/Archive/Zip/Tree.pm
-/usr/lib/perl5/vendor_perl/5.10/Archive/Zip/ZipFileMember.pm
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/CPAN/.packlist b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/CPAN/.packlist
deleted file mode 100644
index e485e9a9d9e..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/CPAN/.packlist
+++ /dev/null
@@ -1,15 +0,0 @@
-/usr/bin/cpan
-/usr/lib/perl5/vendor_perl/5.10/CPAN.pm
-/usr/lib/perl5/vendor_perl/5.10/CPAN/API/HOWTO.pm
-/usr/lib/perl5/vendor_perl/5.10/CPAN/Admin.pm
-/usr/lib/perl5/vendor_perl/5.10/CPAN/Debug.pm
-/usr/lib/perl5/vendor_perl/5.10/CPAN/DeferedCode.pm
-/usr/lib/perl5/vendor_perl/5.10/CPAN/FirstTime.pm
-/usr/lib/perl5/vendor_perl/5.10/CPAN/HandleConfig.pm
-/usr/lib/perl5/vendor_perl/5.10/CPAN/Kwalify.pm
-/usr/lib/perl5/vendor_perl/5.10/CPAN/Kwalify/distroprefs.dd
-/usr/lib/perl5/vendor_perl/5.10/CPAN/Kwalify/distroprefs.yml
-/usr/lib/perl5/vendor_perl/5.10/CPAN/Nox.pm
-/usr/lib/perl5/vendor_perl/5.10/CPAN/Queue.pm
-/usr/lib/perl5/vendor_perl/5.10/CPAN/Tarzip.pm
-/usr/lib/perl5/vendor_perl/5.10/CPAN/Version.pm
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/CPAN/Reporter/.packlist b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/CPAN/Reporter/.packlist
deleted file mode 100644
index c85319ac1a9..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/CPAN/Reporter/.packlist
+++ /dev/null
@@ -1,10 +0,0 @@
-/usr/lib/perl5/vendor_perl/5.10/CPAN/Reporter.pm
-/usr/lib/perl5/vendor_perl/5.10/CPAN/Reporter.pod
-/usr/lib/perl5/vendor_perl/5.10/CPAN/Reporter/API.pod
-/usr/lib/perl5/vendor_perl/5.10/CPAN/Reporter/Config.pm
-/usr/lib/perl5/vendor_perl/5.10/CPAN/Reporter/Config.pod
-/usr/lib/perl5/vendor_perl/5.10/CPAN/Reporter/FAQ.pod
-/usr/lib/perl5/vendor_perl/5.10/CPAN/Reporter/History.pm
-/usr/lib/perl5/vendor_perl/5.10/CPAN/Reporter/History.pod
-/usr/lib/perl5/vendor_perl/5.10/CPAN/Reporter/PrereqCheck.pm
-/usr/lib/perl5/vendor_perl/5.10/CPAN/Reporter/PrereqCheck.pod
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Compress/Bzip2/.packlist b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Compress/Bzip2/.packlist
deleted file mode 100644
index d901a1c4fbd..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Compress/Bzip2/.packlist
+++ /dev/null
@@ -1,3 +0,0 @@
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/Compress/Bzip2.pm
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Compress/Bzip2/Bzip2.dll
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Compress/Bzip2/autosplit.ix
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Compress/Bzip2/Bzip2.dll b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Compress/Bzip2/Bzip2.dll
deleted file mode 100755
index c8c5e4e5328..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Compress/Bzip2/Bzip2.dll
+++ /dev/null
Binary files differ
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Compress/Bzip2/autosplit.ix b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Compress/Bzip2/autosplit.ix
deleted file mode 100644
index ce4be759eaf..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Compress/Bzip2/autosplit.ix
+++ /dev/null
@@ -1,3 +0,0 @@
-# Index created by AutoSplit for blib/lib/Compress/Bzip2.pm
-# (file acts as timestamp)
-1;
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Compress/Raw/Bzip2/.packlist b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Compress/Raw/Bzip2/.packlist
deleted file mode 100644
index 334d6210b18..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Compress/Raw/Bzip2/.packlist
+++ /dev/null
@@ -1,3 +0,0 @@
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/Compress/Raw/Bzip2.pm
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Compress/Raw/Bzip2/Bzip2.dll
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Compress/Raw/Bzip2/autosplit.ix
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Compress/Raw/Bzip2/Bzip2.dll b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Compress/Raw/Bzip2/Bzip2.dll
deleted file mode 100755
index 025e0a00fd7..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Compress/Raw/Bzip2/Bzip2.dll
+++ /dev/null
Binary files differ
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Compress/Raw/Bzip2/autosplit.ix b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Compress/Raw/Bzip2/autosplit.ix
deleted file mode 100644
index 5a2274f3bcc..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Compress/Raw/Bzip2/autosplit.ix
+++ /dev/null
@@ -1,3 +0,0 @@
-# Index created by AutoSplit for blib/lib/Compress/Raw/Bzip2.pm
-# (file acts as timestamp)
-1;
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Config/Tiny/.packlist b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Config/Tiny/.packlist
deleted file mode 100644
index de09e206ebb..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Config/Tiny/.packlist
+++ /dev/null
@@ -1 +0,0 @@
-/usr/lib/perl5/vendor_perl/5.10/Config/Tiny.pm
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Cwd/.packlist b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Cwd/.packlist
deleted file mode 100644
index 80526e3ad66..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Cwd/.packlist
+++ /dev/null
@@ -1,11 +0,0 @@
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/Cwd.pm
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/File/Spec.pm
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/File/Spec/Cygwin.pm
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/File/Spec/Epoc.pm
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/File/Spec/Functions.pm
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/File/Spec/Mac.pm
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/File/Spec/OS2.pm
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/File/Spec/Unix.pm
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/File/Spec/VMS.pm
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/File/Spec/Win32.pm
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Cwd/Cwd.dll
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Cwd/Cwd.dll b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Cwd/Cwd.dll
deleted file mode 100755
index 59be6734617..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Cwd/Cwd.dll
+++ /dev/null
Binary files differ
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Devel/Symdump/.packlist b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Devel/Symdump/.packlist
deleted file mode 100644
index 378df7e5195..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Devel/Symdump/.packlist
+++ /dev/null
@@ -1,2 +0,0 @@
-/usr/lib/perl5/vendor_perl/5.10/Devel/Symdump.pm
-/usr/lib/perl5/vendor_perl/5.10/Devel/Symdump/Export.pm
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Digest/SHA/.packlist b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Digest/SHA/.packlist
deleted file mode 100644
index 2c58e22f960..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Digest/SHA/.packlist
+++ /dev/null
@@ -1,3 +0,0 @@
-/usr/bin/shasum
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/Digest/SHA.pm
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Digest/SHA/SHA.dll
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Digest/SHA/SHA.dll b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Digest/SHA/SHA.dll
deleted file mode 100755
index 188510ef8e0..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Digest/SHA/SHA.dll
+++ /dev/null
Binary files differ
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/File/Copy/Recursive/.packlist b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/File/Copy/Recursive/.packlist
deleted file mode 100644
index 1e67ef6f222..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/File/Copy/Recursive/.packlist
+++ /dev/null
@@ -1 +0,0 @@
-/usr/lib/perl5/vendor_perl/5.10/File/Copy/Recursive.pm
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/File/HomeDir/.packlist b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/File/HomeDir/.packlist
deleted file mode 100644
index f9a14ebbec3..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/File/HomeDir/.packlist
+++ /dev/null
@@ -1,6 +0,0 @@
-/usr/lib/perl5/vendor_perl/5.10/File/HomeDir.pm
-/usr/lib/perl5/vendor_perl/5.10/File/HomeDir/Darwin.pm
-/usr/lib/perl5/vendor_perl/5.10/File/HomeDir/Driver.pm
-/usr/lib/perl5/vendor_perl/5.10/File/HomeDir/MacOS9.pm
-/usr/lib/perl5/vendor_perl/5.10/File/HomeDir/Unix.pm
-/usr/lib/perl5/vendor_perl/5.10/File/HomeDir/Windows.pm
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/File/Temp/.packlist b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/File/Temp/.packlist
deleted file mode 100644
index 3ee277acedb..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/File/Temp/.packlist
+++ /dev/null
@@ -1,2 +0,0 @@
-/usr/lib/perl5/vendor_perl/5.10/File/._Temp.pm
-/usr/lib/perl5/vendor_perl/5.10/File/Temp.pm
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/File/pushd/.packlist b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/File/pushd/.packlist
deleted file mode 100644
index 54e4f7f3a0d..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/File/pushd/.packlist
+++ /dev/null
@@ -1,2 +0,0 @@
-/usr/lib/perl5/vendor_perl/5.10/File/pushd.pm
-/usr/lib/perl5/vendor_perl/5.10/File/pushd.pod
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/HTML/Parser/.packlist b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/HTML/Parser/.packlist
deleted file mode 100644
index 536c184838a..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/HTML/Parser/.packlist
+++ /dev/null
@@ -1,8 +0,0 @@
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/HTML/Entities.pm
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/HTML/Filter.pm
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/HTML/HeadParser.pm
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/HTML/LinkExtor.pm
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/HTML/Parser.pm
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/HTML/PullParser.pm
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/HTML/TokeParser.pm
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/HTML/Parser/Parser.dll
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/HTML/Parser/Parser.dll b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/HTML/Parser/Parser.dll
deleted file mode 100755
index 822da84225d..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/HTML/Parser/Parser.dll
+++ /dev/null
Binary files differ
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/HTML/Tagset/.packlist b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/HTML/Tagset/.packlist
deleted file mode 100644
index da214b4a7a1..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/HTML/Tagset/.packlist
+++ /dev/null
@@ -1 +0,0 @@
-/usr/lib/perl5/vendor_perl/5.10/HTML/Tagset.pm
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/IO/CaptureOutput/.packlist b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/IO/CaptureOutput/.packlist
deleted file mode 100644
index 94734507600..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/IO/CaptureOutput/.packlist
+++ /dev/null
@@ -1,2 +0,0 @@
-/usr/lib/perl5/vendor_perl/5.10/IO/CaptureOutput.pm
-/usr/lib/perl5/vendor_perl/5.10/IO/CaptureOutput.pod
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/IO/Compress/Bzip2/.packlist b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/IO/Compress/Bzip2/.packlist
deleted file mode 100644
index 53609083bfd..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/IO/Compress/Bzip2/.packlist
+++ /dev/null
@@ -1,4 +0,0 @@
-/usr/lib/perl5/vendor_perl/5.10/IO/Compress/Adapter/Bzip2.pm
-/usr/lib/perl5/vendor_perl/5.10/IO/Compress/Bzip2.pm
-/usr/lib/perl5/vendor_perl/5.10/IO/Uncompress/Adapter/Bunzip2.pm
-/usr/lib/perl5/vendor_perl/5.10/IO/Uncompress/Bunzip2.pm
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/IO/String/.packlist b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/IO/String/.packlist
deleted file mode 100644
index 0183b8af891..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/IO/String/.packlist
+++ /dev/null
@@ -1 +0,0 @@
-/usr/lib/perl5/vendor_perl/5.10/IO/String.pm
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/IPC/Run3/.packlist b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/IPC/Run3/.packlist
deleted file mode 100644
index 9eaa5a1b6c7..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/IPC/Run3/.packlist
+++ /dev/null
@@ -1,6 +0,0 @@
-/usr/lib/perl5/vendor_perl/5.10/IPC/Run3.pm
-/usr/lib/perl5/vendor_perl/5.10/IPC/Run3/ProfArrayBuffer.pm
-/usr/lib/perl5/vendor_perl/5.10/IPC/Run3/ProfLogReader.pm
-/usr/lib/perl5/vendor_perl/5.10/IPC/Run3/ProfLogger.pm
-/usr/lib/perl5/vendor_perl/5.10/IPC/Run3/ProfPP.pm
-/usr/lib/perl5/vendor_perl/5.10/IPC/Run3/ProfReporter.pm
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/LWP/.packlist b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/LWP/.packlist
deleted file mode 100644
index b285259ba3b..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/LWP/.packlist
+++ /dev/null
@@ -1,54 +0,0 @@
-/usr/lib/perl5/vendor_perl/5.10/Bundle/LWP.pm
-/usr/lib/perl5/vendor_perl/5.10/File/Listing.pm
-/usr/lib/perl5/vendor_perl/5.10/HTML/Form.pm
-/usr/lib/perl5/vendor_perl/5.10/HTTP/Cookies.pm
-/usr/lib/perl5/vendor_perl/5.10/HTTP/Cookies/Microsoft.pm
-/usr/lib/perl5/vendor_perl/5.10/HTTP/Cookies/Netscape.pm
-/usr/lib/perl5/vendor_perl/5.10/HTTP/Daemon.pm
-/usr/lib/perl5/vendor_perl/5.10/HTTP/Date.pm
-/usr/lib/perl5/vendor_perl/5.10/HTTP/Headers.pm
-/usr/lib/perl5/vendor_perl/5.10/HTTP/Headers/Auth.pm
-/usr/lib/perl5/vendor_perl/5.10/HTTP/Headers/ETag.pm
-/usr/lib/perl5/vendor_perl/5.10/HTTP/Headers/Util.pm
-/usr/lib/perl5/vendor_perl/5.10/HTTP/Message.pm
-/usr/lib/perl5/vendor_perl/5.10/HTTP/Negotiate.pm
-/usr/lib/perl5/vendor_perl/5.10/HTTP/Request.pm
-/usr/lib/perl5/vendor_perl/5.10/HTTP/Request/Common.pm
-/usr/lib/perl5/vendor_perl/5.10/HTTP/Response.pm
-/usr/lib/perl5/vendor_perl/5.10/HTTP/Status.pm
-/usr/lib/perl5/vendor_perl/5.10/LWP.pm
-/usr/lib/perl5/vendor_perl/5.10/LWP/Authen/Basic.pm
-/usr/lib/perl5/vendor_perl/5.10/LWP/Authen/Digest.pm
-/usr/lib/perl5/vendor_perl/5.10/LWP/Authen/Ntlm.pm
-/usr/lib/perl5/vendor_perl/5.10/LWP/ConnCache.pm
-/usr/lib/perl5/vendor_perl/5.10/LWP/Debug.pm
-/usr/lib/perl5/vendor_perl/5.10/LWP/DebugFile.pm
-/usr/lib/perl5/vendor_perl/5.10/LWP/MediaTypes.pm
-/usr/lib/perl5/vendor_perl/5.10/LWP/MemberMixin.pm
-/usr/lib/perl5/vendor_perl/5.10/LWP/Protocol.pm
-/usr/lib/perl5/vendor_perl/5.10/LWP/Protocol/GHTTP.pm
-/usr/lib/perl5/vendor_perl/5.10/LWP/Protocol/cpan.pm
-/usr/lib/perl5/vendor_perl/5.10/LWP/Protocol/data.pm
-/usr/lib/perl5/vendor_perl/5.10/LWP/Protocol/file.pm
-/usr/lib/perl5/vendor_perl/5.10/LWP/Protocol/ftp.pm
-/usr/lib/perl5/vendor_perl/5.10/LWP/Protocol/gopher.pm
-/usr/lib/perl5/vendor_perl/5.10/LWP/Protocol/http.pm
-/usr/lib/perl5/vendor_perl/5.10/LWP/Protocol/http10.pm
-/usr/lib/perl5/vendor_perl/5.10/LWP/Protocol/https.pm
-/usr/lib/perl5/vendor_perl/5.10/LWP/Protocol/https10.pm
-/usr/lib/perl5/vendor_perl/5.10/LWP/Protocol/loopback.pm
-/usr/lib/perl5/vendor_perl/5.10/LWP/Protocol/mailto.pm
-/usr/lib/perl5/vendor_perl/5.10/LWP/Protocol/nntp.pm
-/usr/lib/perl5/vendor_perl/5.10/LWP/Protocol/nogo.pm
-/usr/lib/perl5/vendor_perl/5.10/LWP/RobotUA.pm
-/usr/lib/perl5/vendor_perl/5.10/LWP/Simple.pm
-/usr/lib/perl5/vendor_perl/5.10/LWP/UserAgent.pm
-/usr/lib/perl5/vendor_perl/5.10/LWP/media.types
-/usr/lib/perl5/vendor_perl/5.10/Net/HTTP.pm
-/usr/lib/perl5/vendor_perl/5.10/Net/HTTP/Methods.pm
-/usr/lib/perl5/vendor_perl/5.10/Net/HTTP/NB.pm
-/usr/lib/perl5/vendor_perl/5.10/Net/HTTPS.pm
-/usr/lib/perl5/vendor_perl/5.10/WWW/RobotRules.pm
-/usr/lib/perl5/vendor_perl/5.10/WWW/RobotRules/AnyDBM_File.pm
-/usr/lib/perl5/vendor_perl/5.10/lwpcook.pod
-/usr/lib/perl5/vendor_perl/5.10/lwptut.pod
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Math/BigInt/FastCalc/.packlist b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Math/BigInt/FastCalc/.packlist
deleted file mode 100644
index bc611494199..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Math/BigInt/FastCalc/.packlist
+++ /dev/null
@@ -1,2 +0,0 @@
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/Math/BigInt/FastCalc.pm
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Math/BigInt/FastCalc/FastCalc.dll
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Math/BigInt/FastCalc/FastCalc.dll b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Math/BigInt/FastCalc/FastCalc.dll
deleted file mode 100755
index a1c1538f710..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Math/BigInt/FastCalc/FastCalc.dll
+++ /dev/null
Binary files differ
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Module/ScanDeps/.packlist b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Module/ScanDeps/.packlist
deleted file mode 100644
index 3c23dd35ca8..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Module/ScanDeps/.packlist
+++ /dev/null
@@ -1,3 +0,0 @@
-/usr/bin/scandeps.pl
-/usr/lib/perl5/vendor_perl/5.10/Module/ScanDeps.pm
-/usr/lib/perl5/vendor_perl/5.10/Module/ScanDeps/DataFeed.pm
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Module/Signature/.packlist b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Module/Signature/.packlist
deleted file mode 100644
index 953af516e76..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Module/Signature/.packlist
+++ /dev/null
@@ -1,2 +0,0 @@
-/usr/bin/cpansign
-/usr/lib/perl5/vendor_perl/5.10/Module/Signature.pm
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Net/DNS/.packlist b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Net/DNS/.packlist
deleted file mode 100644
index ae1661b4792..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Net/DNS/.packlist
+++ /dev/null
@@ -1,50 +0,0 @@
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS.pm
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/FAQ.pod
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/Header.pm
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/Nameserver.pm
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/Packet.pm
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/Question.pm
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR.pm
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/A.pm
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/AAAA.pm
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/AFSDB.pm
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/CERT.pm
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/CNAME.pm
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/DNAME.pm
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/EID.pm
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/HINFO.pm
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/IPSECKEY.pm
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/ISDN.pm
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/LOC.pm
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/MB.pm
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/MG.pm
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/MINFO.pm
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/MR.pm
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/MX.pm
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/NAPTR.pm
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/NIMLOC.pm
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/NS.pm
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/NSAP.pm
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/NULL.pm
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/OPT.pm
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/PTR.pm
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/PX.pm
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/RP.pm
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/RT.pm
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/SOA.pm
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/SPF.pm
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/SRV.pm
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/SSHFP.pm
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/TKEY.pm
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/TSIG.pm
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/TXT.pm
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/Unknown.pm
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/RR/X25.pm
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/Resolver.pm
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/Resolver/Base.pm
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/Resolver/Cygwin.pm
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/Resolver/Recurse.pm
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/Resolver/UNIX.pm
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/Resolver/Win32.pm
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/Net/DNS/Update.pm
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Net/DNS/DNS.dll
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Net/DNS/DNS.dll b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Net/DNS/DNS.dll
deleted file mode 100755
index ebde3bdecbb..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Net/DNS/DNS.dll
+++ /dev/null
Binary files differ
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Net/Telnet/.packlist b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Net/Telnet/.packlist
deleted file mode 100644
index dd686633e6e..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Net/Telnet/.packlist
+++ /dev/null
@@ -1 +0,0 @@
-/usr/lib/perl5/vendor_perl/5.10/Net/Telnet.pm
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/PAR/Dist/.packlist b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/PAR/Dist/.packlist
deleted file mode 100644
index 676970bd63c..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/PAR/Dist/.packlist
+++ /dev/null
@@ -1 +0,0 @@
-/usr/lib/perl5/vendor_perl/5.10/PAR/Dist.pm
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/PadWalker/.packlist b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/PadWalker/.packlist
deleted file mode 100644
index e05b710331c..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/PadWalker/.packlist
+++ /dev/null
@@ -1,2 +0,0 @@
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/PadWalker.pm
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/PadWalker/PadWalker.dll
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/PadWalker/PadWalker.dll b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/PadWalker/PadWalker.dll
deleted file mode 100755
index 94fa5bfd038..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/PadWalker/PadWalker.dll
+++ /dev/null
Binary files differ
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Pod/Coverage/.packlist b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Pod/Coverage/.packlist
deleted file mode 100644
index df1665484b6..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Pod/Coverage/.packlist
+++ /dev/null
@@ -1,5 +0,0 @@
-/usr/bin/pod_cover
-/usr/lib/perl5/vendor_perl/5.10/Pod/Coverage.pm
-/usr/lib/perl5/vendor_perl/5.10/Pod/Coverage/CountParents.pm
-/usr/lib/perl5/vendor_perl/5.10/Pod/Coverage/ExportOnly.pm
-/usr/lib/perl5/vendor_perl/5.10/Pod/Coverage/Overloader.pm
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Pod/Escapes/.packlist b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Pod/Escapes/.packlist
deleted file mode 100644
index ba223b33326..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Pod/Escapes/.packlist
+++ /dev/null
@@ -1 +0,0 @@
-/usr/lib/perl5/vendor_perl/5.10/Pod/Escapes.pm
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Pod/Simple/.packlist b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Pod/Simple/.packlist
deleted file mode 100644
index 455bc50831a..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Pod/Simple/.packlist
+++ /dev/null
@@ -1,31 +0,0 @@
-/usr/lib/perl5/vendor_perl/5.10/Pod/Simple.pm
-/usr/lib/perl5/vendor_perl/5.10/Pod/Simple.pod
-/usr/lib/perl5/vendor_perl/5.10/Pod/Simple/BlackBox.pm
-/usr/lib/perl5/vendor_perl/5.10/Pod/Simple/Checker.pm
-/usr/lib/perl5/vendor_perl/5.10/Pod/Simple/Debug.pm
-/usr/lib/perl5/vendor_perl/5.10/Pod/Simple/DumpAsText.pm
-/usr/lib/perl5/vendor_perl/5.10/Pod/Simple/DumpAsXML.pm
-/usr/lib/perl5/vendor_perl/5.10/Pod/Simple/HTML.pm
-/usr/lib/perl5/vendor_perl/5.10/Pod/Simple/HTMLBatch.pm
-/usr/lib/perl5/vendor_perl/5.10/Pod/Simple/HTMLLegacy.pm
-/usr/lib/perl5/vendor_perl/5.10/Pod/Simple/LinkSection.pm
-/usr/lib/perl5/vendor_perl/5.10/Pod/Simple/Methody.pm
-/usr/lib/perl5/vendor_perl/5.10/Pod/Simple/Progress.pm
-/usr/lib/perl5/vendor_perl/5.10/Pod/Simple/PullParser.pm
-/usr/lib/perl5/vendor_perl/5.10/Pod/Simple/PullParserEndToken.pm
-/usr/lib/perl5/vendor_perl/5.10/Pod/Simple/PullParserStartToken.pm
-/usr/lib/perl5/vendor_perl/5.10/Pod/Simple/PullParserTextToken.pm
-/usr/lib/perl5/vendor_perl/5.10/Pod/Simple/PullParserToken.pm
-/usr/lib/perl5/vendor_perl/5.10/Pod/Simple/RTF.pm
-/usr/lib/perl5/vendor_perl/5.10/Pod/Simple/Search.pm
-/usr/lib/perl5/vendor_perl/5.10/Pod/Simple/SimpleTree.pm
-/usr/lib/perl5/vendor_perl/5.10/Pod/Simple/Subclassing.pod
-/usr/lib/perl5/vendor_perl/5.10/Pod/Simple/Text.pm
-/usr/lib/perl5/vendor_perl/5.10/Pod/Simple/TextContent.pm
-/usr/lib/perl5/vendor_perl/5.10/Pod/Simple/TiedOutFH.pm
-/usr/lib/perl5/vendor_perl/5.10/Pod/Simple/Transcode.pm
-/usr/lib/perl5/vendor_perl/5.10/Pod/Simple/TranscodeDumb.pm
-/usr/lib/perl5/vendor_perl/5.10/Pod/Simple/TranscodeSmart.pm
-/usr/lib/perl5/vendor_perl/5.10/Pod/Simple/XMLOutStream.pm
-/usr/lib/perl5/vendor_perl/5.10/perlpod.pod
-/usr/lib/perl5/vendor_perl/5.10/perlpodspec.pod
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Probe/Perl/.packlist b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Probe/Perl/.packlist
deleted file mode 100644
index 8884166c6be..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Probe/Perl/.packlist
+++ /dev/null
@@ -1 +0,0 @@
-/usr/lib/perl5/vendor_perl/5.10/Probe/Perl.pm
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Proc/ProcessTable/.packlist b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Proc/ProcessTable/.packlist
deleted file mode 100644
index 0b3053d08ec..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Proc/ProcessTable/.packlist
+++ /dev/null
@@ -1,7 +0,0 @@
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/Proc/Killall.pm
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/Proc/Killfam.pm
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/Proc/ProcessTable.pm
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/Proc/ProcessTable/Process.pm
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/Proc/example.pl
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Proc/ProcessTable/Process/autosplit.ix
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Proc/ProcessTable/ProcessTable.dll
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Proc/ProcessTable/Process/autosplit.ix b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Proc/ProcessTable/Process/autosplit.ix
deleted file mode 100644
index bf94c0912ca..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Proc/ProcessTable/Process/autosplit.ix
+++ /dev/null
@@ -1,3 +0,0 @@
-# Index created by AutoSplit for ../blib/lib/Proc/ProcessTable/Process.pm
-# (file acts as timestamp)
-1;
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Proc/ProcessTable/ProcessTable.dll b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Proc/ProcessTable/ProcessTable.dll
deleted file mode 100755
index e7fa59d11f5..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Proc/ProcessTable/ProcessTable.dll
+++ /dev/null
Binary files differ
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Tee/.packlist b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Tee/.packlist
deleted file mode 100644
index 3b3b84d9a92..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Tee/.packlist
+++ /dev/null
@@ -1,4 +0,0 @@
-/usr/bin/ptee
-/usr/lib/perl5/vendor_perl/5.10/Tee.pm
-/usr/lib/perl5/vendor_perl/5.10/Tee.pod
-/usr/lib/perl5/vendor_perl/5.10/auto/Tee/ptee
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Term/ReadKey/.packlist b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Term/ReadKey/.packlist
deleted file mode 100644
index a82d1eed5ec..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Term/ReadKey/.packlist
+++ /dev/null
@@ -1,3 +0,0 @@
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/Term/ReadKey.pm
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Term/ReadKey/ReadKey.dll
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Term/ReadKey/autosplit.ix
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Term/ReadKey/ReadKey.dll b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Term/ReadKey/ReadKey.dll
deleted file mode 100755
index c470828e220..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Term/ReadKey/ReadKey.dll
+++ /dev/null
Binary files differ
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Term/ReadKey/autosplit.ix b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Term/ReadKey/autosplit.ix
deleted file mode 100644
index 1f3f099bd2b..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Term/ReadKey/autosplit.ix
+++ /dev/null
@@ -1,3 +0,0 @@
-# Index created by AutoSplit for blib/lib/Term/ReadKey.pm
-# (file acts as timestamp)
-1;
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Term/ReadLine/.packlist b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Term/ReadLine/.packlist
deleted file mode 100644
index 1ac941addda..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Term/ReadLine/.packlist
+++ /dev/null
@@ -1,2 +0,0 @@
-/usr/lib/perl5/vendor_perl/5.10/Term/ReadLine/Perl.pm
-/usr/lib/perl5/vendor_perl/5.10/Term/ReadLine/readline.pm
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Term/ReadLine/Gnu/.packlist b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Term/ReadLine/Gnu/.packlist
deleted file mode 100644
index 30df7ed3a81..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Term/ReadLine/Gnu/.packlist
+++ /dev/null
@@ -1,4 +0,0 @@
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/Term/ReadLine/Gnu.pm
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/Term/ReadLine/Gnu/XS.pm
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Term/ReadLine/Gnu/Gnu.dll
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Term/ReadLine/Gnu/XS/autosplit.ix
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Term/ReadLine/Gnu/Gnu.dll b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Term/ReadLine/Gnu/Gnu.dll
deleted file mode 100755
index 7be6a1f36e6..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Term/ReadLine/Gnu/Gnu.dll
+++ /dev/null
Binary files differ
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Term/ReadLine/Gnu/XS/autosplit.ix b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Term/ReadLine/Gnu/XS/autosplit.ix
deleted file mode 100644
index 8b9f60db04f..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Term/ReadLine/Gnu/XS/autosplit.ix
+++ /dev/null
@@ -1,3 +0,0 @@
-# Index created by AutoSplit for blib/lib/Term/ReadLine/Gnu/XS.pm
-# (file acts as timestamp)
-1;
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Test/Pod/.packlist b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Test/Pod/.packlist
deleted file mode 100644
index 2812e87c8d4..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Test/Pod/.packlist
+++ /dev/null
@@ -1 +0,0 @@
-/usr/lib/perl5/vendor_perl/5.10/Test/Pod.pm
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Test/Pod/Coverage/.packlist b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Test/Pod/Coverage/.packlist
deleted file mode 100644
index 3ea96169b81..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Test/Pod/Coverage/.packlist
+++ /dev/null
@@ -1 +0,0 @@
-/usr/lib/perl5/vendor_perl/5.10/Test/Pod/Coverage.pm
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Test/Reporter/.packlist b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Test/Reporter/.packlist
deleted file mode 100644
index 60a1fd2c5f7..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/Test/Reporter/.packlist
+++ /dev/null
@@ -1,8 +0,0 @@
-/usr/bin/cpantest
-/usr/lib/perl5/vendor_perl/5.10/Test/Reporter.pm
-/usr/lib/perl5/vendor_perl/5.10/Test/Reporter/Transport.pm
-/usr/lib/perl5/vendor_perl/5.10/Test/Reporter/Transport/File.pm
-/usr/lib/perl5/vendor_perl/5.10/Test/Reporter/Transport/HTTPGateway.pm
-/usr/lib/perl5/vendor_perl/5.10/Test/Reporter/Transport/Mail/Send.pm
-/usr/lib/perl5/vendor_perl/5.10/Test/Reporter/Transport/Net/SMTP.pm
-/usr/lib/perl5/vendor_perl/5.10/Test/Reporter/Transport/Net/SMTP/TLS.pm
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/URI/.packlist b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/URI/.packlist
deleted file mode 100644
index 703246950b1..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/URI/.packlist
+++ /dev/null
@@ -1,49 +0,0 @@
-/usr/lib/perl5/vendor_perl/5.10/URI.pm
-/usr/lib/perl5/vendor_perl/5.10/URI/Escape.pm
-/usr/lib/perl5/vendor_perl/5.10/URI/Heuristic.pm
-/usr/lib/perl5/vendor_perl/5.10/URI/QueryParam.pm
-/usr/lib/perl5/vendor_perl/5.10/URI/Split.pm
-/usr/lib/perl5/vendor_perl/5.10/URI/URL.pm
-/usr/lib/perl5/vendor_perl/5.10/URI/WithBase.pm
-/usr/lib/perl5/vendor_perl/5.10/URI/_foreign.pm
-/usr/lib/perl5/vendor_perl/5.10/URI/_generic.pm
-/usr/lib/perl5/vendor_perl/5.10/URI/_ldap.pm
-/usr/lib/perl5/vendor_perl/5.10/URI/_login.pm
-/usr/lib/perl5/vendor_perl/5.10/URI/_query.pm
-/usr/lib/perl5/vendor_perl/5.10/URI/_segment.pm
-/usr/lib/perl5/vendor_perl/5.10/URI/_server.pm
-/usr/lib/perl5/vendor_perl/5.10/URI/_userpass.pm
-/usr/lib/perl5/vendor_perl/5.10/URI/data.pm
-/usr/lib/perl5/vendor_perl/5.10/URI/file.pm
-/usr/lib/perl5/vendor_perl/5.10/URI/file/Base.pm
-/usr/lib/perl5/vendor_perl/5.10/URI/file/FAT.pm
-/usr/lib/perl5/vendor_perl/5.10/URI/file/Mac.pm
-/usr/lib/perl5/vendor_perl/5.10/URI/file/OS2.pm
-/usr/lib/perl5/vendor_perl/5.10/URI/file/QNX.pm
-/usr/lib/perl5/vendor_perl/5.10/URI/file/Unix.pm
-/usr/lib/perl5/vendor_perl/5.10/URI/file/Win32.pm
-/usr/lib/perl5/vendor_perl/5.10/URI/ftp.pm
-/usr/lib/perl5/vendor_perl/5.10/URI/gopher.pm
-/usr/lib/perl5/vendor_perl/5.10/URI/http.pm
-/usr/lib/perl5/vendor_perl/5.10/URI/https.pm
-/usr/lib/perl5/vendor_perl/5.10/URI/ldap.pm
-/usr/lib/perl5/vendor_perl/5.10/URI/ldapi.pm
-/usr/lib/perl5/vendor_perl/5.10/URI/ldaps.pm
-/usr/lib/perl5/vendor_perl/5.10/URI/mailto.pm
-/usr/lib/perl5/vendor_perl/5.10/URI/mms.pm
-/usr/lib/perl5/vendor_perl/5.10/URI/news.pm
-/usr/lib/perl5/vendor_perl/5.10/URI/nntp.pm
-/usr/lib/perl5/vendor_perl/5.10/URI/pop.pm
-/usr/lib/perl5/vendor_perl/5.10/URI/rlogin.pm
-/usr/lib/perl5/vendor_perl/5.10/URI/rsync.pm
-/usr/lib/perl5/vendor_perl/5.10/URI/rtsp.pm
-/usr/lib/perl5/vendor_perl/5.10/URI/rtspu.pm
-/usr/lib/perl5/vendor_perl/5.10/URI/sip.pm
-/usr/lib/perl5/vendor_perl/5.10/URI/sips.pm
-/usr/lib/perl5/vendor_perl/5.10/URI/snews.pm
-/usr/lib/perl5/vendor_perl/5.10/URI/ssh.pm
-/usr/lib/perl5/vendor_perl/5.10/URI/telnet.pm
-/usr/lib/perl5/vendor_perl/5.10/URI/tn3270.pm
-/usr/lib/perl5/vendor_perl/5.10/URI/urn.pm
-/usr/lib/perl5/vendor_perl/5.10/URI/urn/isbn.pm
-/usr/lib/perl5/vendor_perl/5.10/URI/urn/oid.pm
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/XML/LibXML/.packlist b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/XML/LibXML/.packlist
deleted file mode 100644
index 199cc41357a..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/XML/LibXML/.packlist
+++ /dev/null
@@ -1,33 +0,0 @@
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML.pm
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML.pod
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/Attr.pod
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/Boolean.pm
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/CDATASection.pod
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/Comment.pod
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/DOM.pod
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/Document.pod
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/DocumentFragment.pod
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/Dtd.pod
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/Element.pod
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/InputCallback.pod
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/Literal.pm
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/Namespace.pod
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/Node.pod
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/NodeList.pm
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/Number.pm
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/PI.pod
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/Parser.pod
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/Reader.pm
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/Reader.pod
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/RelaxNG.pod
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/SAX.pm
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/SAX.pod
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/SAX/Builder.pm
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/SAX/Builder.pod
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/SAX/Generator.pm
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/SAX/Parser.pm
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/Schema.pod
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/Text.pod
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/XPathContext.pm
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/XPathContext.pod
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/XML/LibXML/LibXML.dll
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/XML/LibXML/Common/.packlist b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/XML/LibXML/Common/.packlist
deleted file mode 100644
index 27498d344f4..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/XML/LibXML/Common/.packlist
+++ /dev/null
@@ -1,2 +0,0 @@
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/LibXML/Common.pm
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/XML/LibXML/Common/Common.dll
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/XML/LibXML/Common/Common.dll b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/XML/LibXML/Common/Common.dll
deleted file mode 100755
index 85aadc887b0..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/XML/LibXML/Common/Common.dll
+++ /dev/null
Binary files differ
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/XML/LibXML/LibXML.dll b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/XML/LibXML/LibXML.dll
deleted file mode 100755
index 53675c19d0b..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/XML/LibXML/LibXML.dll
+++ /dev/null
Binary files differ
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/XML/NamespaceSupport/.packlist b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/XML/NamespaceSupport/.packlist
deleted file mode 100644
index ae6ffd04517..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/XML/NamespaceSupport/.packlist
+++ /dev/null
@@ -1 +0,0 @@
-/usr/lib/perl5/vendor_perl/5.10/XML/NamespaceSupport.pm
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/XML/Parser/.packlist b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/XML/Parser/.packlist
deleted file mode 100644
index 5f2765f340c..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/XML/Parser/.packlist
+++ /dev/null
@@ -1,28 +0,0 @@
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/Parser.pm
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/Parser/Encodings/Japanese_Encodings.msg
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/Parser/Encodings/README
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/Parser/Encodings/big5.enc
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/Parser/Encodings/euc-kr.enc
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/Parser/Encodings/iso-8859-2.enc
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/Parser/Encodings/iso-8859-3.enc
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/Parser/Encodings/iso-8859-4.enc
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/Parser/Encodings/iso-8859-5.enc
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/Parser/Encodings/iso-8859-7.enc
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/Parser/Encodings/iso-8859-8.enc
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/Parser/Encodings/iso-8859-9.enc
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/Parser/Encodings/windows-1250.enc
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/Parser/Encodings/windows-1252.enc
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/Parser/Encodings/x-euc-jp-jisx0221.enc
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/Parser/Encodings/x-euc-jp-unicode.enc
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/Parser/Encodings/x-sjis-cp932.enc
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/Parser/Encodings/x-sjis-jdk117.enc
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/Parser/Encodings/x-sjis-jisx0221.enc
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/Parser/Encodings/x-sjis-unicode.enc
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/Parser/Expat.pm
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/Parser/LWPExternEnt.pl
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/Parser/Style/Debug.pm
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/Parser/Style/Objects.pm
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/Parser/Style/Stream.pm
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/Parser/Style/Subs.pm
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/XML/Parser/Style/Tree.pm
-/usr/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/XML/Parser/Expat/Expat.dll
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/XML/Parser/Expat/Expat.dll b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/XML/Parser/Expat/Expat.dll
deleted file mode 100755
index db0575308b5..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/XML/Parser/Expat/Expat.dll
+++ /dev/null
Binary files differ
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/XML/SAX/.packlist b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/XML/SAX/.packlist
deleted file mode 100644
index af1203abb80..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/XML/SAX/.packlist
+++ /dev/null
@@ -1,23 +0,0 @@
-/usr/lib/perl5/vendor_perl/5.10/XML/SAX.pm
-/usr/lib/perl5/vendor_perl/5.10/XML/SAX/Base.pm
-/usr/lib/perl5/vendor_perl/5.10/XML/SAX/DocumentLocator.pm
-/usr/lib/perl5/vendor_perl/5.10/XML/SAX/Exception.pm
-/usr/lib/perl5/vendor_perl/5.10/XML/SAX/Intro.pod
-/usr/lib/perl5/vendor_perl/5.10/XML/SAX/ParserFactory.pm
-/usr/lib/perl5/vendor_perl/5.10/XML/SAX/PurePerl.pm
-/usr/lib/perl5/vendor_perl/5.10/XML/SAX/PurePerl/DTDDecls.pm
-/usr/lib/perl5/vendor_perl/5.10/XML/SAX/PurePerl/DebugHandler.pm
-/usr/lib/perl5/vendor_perl/5.10/XML/SAX/PurePerl/DocType.pm
-/usr/lib/perl5/vendor_perl/5.10/XML/SAX/PurePerl/EncodingDetect.pm
-/usr/lib/perl5/vendor_perl/5.10/XML/SAX/PurePerl/Exception.pm
-/usr/lib/perl5/vendor_perl/5.10/XML/SAX/PurePerl/NoUnicodeExt.pm
-/usr/lib/perl5/vendor_perl/5.10/XML/SAX/PurePerl/Productions.pm
-/usr/lib/perl5/vendor_perl/5.10/XML/SAX/PurePerl/Reader.pm
-/usr/lib/perl5/vendor_perl/5.10/XML/SAX/PurePerl/Reader/NoUnicodeExt.pm
-/usr/lib/perl5/vendor_perl/5.10/XML/SAX/PurePerl/Reader/Stream.pm
-/usr/lib/perl5/vendor_perl/5.10/XML/SAX/PurePerl/Reader/String.pm
-/usr/lib/perl5/vendor_perl/5.10/XML/SAX/PurePerl/Reader/URI.pm
-/usr/lib/perl5/vendor_perl/5.10/XML/SAX/PurePerl/Reader/UnicodeExt.pm
-/usr/lib/perl5/vendor_perl/5.10/XML/SAX/PurePerl/UnicodeExt.pm
-/usr/lib/perl5/vendor_perl/5.10/XML/SAX/PurePerl/XMLDecl.pm
-/usr/lib/perl5/vendor_perl/5.10/XML/SAX/placeholder.pl
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/YAML/.packlist b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/YAML/.packlist
deleted file mode 100644
index 90c520e21f1..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/i686-cygwin/auto/YAML/.packlist
+++ /dev/null
@@ -1,13 +0,0 @@
-/usr/bin/ysh
-/usr/lib/perl5/vendor_perl/5.10/Test/YAML.pm
-/usr/lib/perl5/vendor_perl/5.10/YAML.pm
-/usr/lib/perl5/vendor_perl/5.10/YAML/Base.pm
-/usr/lib/perl5/vendor_perl/5.10/YAML/Dumper.pm
-/usr/lib/perl5/vendor_perl/5.10/YAML/Dumper/Base.pm
-/usr/lib/perl5/vendor_perl/5.10/YAML/Error.pm
-/usr/lib/perl5/vendor_perl/5.10/YAML/Loader.pm
-/usr/lib/perl5/vendor_perl/5.10/YAML/Loader/Base.pm
-/usr/lib/perl5/vendor_perl/5.10/YAML/Marshall.pm
-/usr/lib/perl5/vendor_perl/5.10/YAML/Node.pm
-/usr/lib/perl5/vendor_perl/5.10/YAML/Tag.pm
-/usr/lib/perl5/vendor_perl/5.10/YAML/Types.pm
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/lwpcook.pod b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/lwpcook.pod
deleted file mode 100644
index 38b4a295e9e..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/lwpcook.pod
+++ /dev/null
@@ -1,309 +0,0 @@
-=head1 NAME
-
-lwpcook - The libwww-perl cookbook
-
-=head1 DESCRIPTION
-
-This document contain some examples that show typical usage of the
-libwww-perl library. You should consult the documentation for the
-individual modules for more detail.
-
-All examples should be runnable programs. You can, in most cases, test
-the code sections by piping the program text directly to perl.
-
-
-
-=head1 GET
-
-It is very easy to use this library to just fetch documents from the
-net. The LWP::Simple module provides the get() function that return
-the document specified by its URL argument:
-
- use LWP::Simple;
- $doc = get 'http://www.linpro.no/lwp/';
-
-or, as a perl one-liner using the getprint() function:
-
- perl -MLWP::Simple -e 'getprint "http://www.linpro.no/lwp/"'
-
-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.perl.com/perl/CPAN/CPAN.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://www.linpro.no/lwp');
- $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 => 'http://www.perl.com/cgi-bin/BugGlimpse');
- $req->content_type('application/x-www-form-urlencoded');
- $req->content('match=www&errors=0');
-
- 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 'http://www.perl.com/cgi-bin/BugGlimpse',
- [ search => 'www', errors => 0 ];
-
- 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.
-
- use LWP::UserAgent;
- use HTTP::Cookies;
-
- $ua = LWP::UserAgent->new;
- $ua->cookie_jar(HTTP::Cookies->new(file => "lwpcookies.txt",
- autosave => 1));
-
- # and then send requests just as you used to do
- $res = $ua->request(HTTP::Request->new(GET => "http://www.yahoo.no"));
- print $res->status_line, "\n";
-
-As you visit sites that send you cookies to keep, then the file
-F<lwpcookies.txt"> will grow.
-
-=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://www.sn.no/libwww-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 transfered 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.linpro.no/lwp/libwww-perl-5.46.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.unit.no/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/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/lwptut.pod b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/lwptut.pod
deleted file mode 100644
index 6a505151314..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/lwptut.pod
+++ /dev/null
@@ -1,837 +0,0 @@
-=head1 NAME
-
-lwptut -- An LWP Tutorial
-
-=head1 DESCRIPTION
-
-LWP (short for "Library for WWW in Perl") is a very popular group of
-Perl modules for accessing data on the Web. Like most Perl
-module-distributions, each of LWP's component modules comes with
-documentation that is a complete reference to its interface. However,
-there are so many modules in LWP that it's hard to know where to start
-looking for information on how to do even the simplest most common
-things.
-
-Really introducing you to using LWP would require a whole book -- a book
-that just happens to exist, called I<Perl & LWP>. But this article
-should give you a taste of how you can go about some common tasks with
-LWP.
-
-
-=head2 Getting documents with LWP::Simple
-
-If you just want to get what's at a particular URL, the simplest way
-to do it is LWP::Simple's functions.
-
-In a Perl program, you can call its C<get($url)> function. It will try
-getting that URL's content. If it works, then it'll return the
-content; but if there's some error, it'll return undef.
-
- my $url = 'http://freshair.npr.org/dayFA.cfm?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://cpan.org/RECENT'"
-
-That is the URL of a plaintext 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://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://freshair.npr.org/dayFA.cfm?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<HTML::Response>, and its superclasses
-L<HTML::Message> and L<HTML::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 more Netscape-like 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 can know about. It can correspond to a
-file on disk (the way Netscape uses its F<cookies.txt> file), or it can
-be just 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:
-
- $browser->cookie_jar({});
-
-To give it a copy that will be read from a file on disk, and will be saved
-to it when the program is finished running, set the C<cookie_jar> attribute
-like this:
-
- use HTTP::Cookies;
- $browser->cookie_jar( HTTP::Cookies->new(
- 'file' => '/some/where/cookies.lwp',
- # where to read/write cookies
- 'autosave' => 1,
- # save it to disk when done
- ));
-
-That file will be an LWP-specific format. If you want to be access the
-cookies in your Netscape cookies file, you can use the
-HTTP::Cookies::Netscape class:
-
- use HTTP::Cookies;
- # yes, loads HTTP::Cookies::Netscape too
-
- $browser->cookie_jar( HTTP::Cookies::Netscape->new(
- 'file' => 'c:/Program Files/Netscape/Users/DIR-NAME-HERE/cookies.txt',
- # where to read cookies
- ));
-
-You could add an C<< 'autosave' => 1 >> line as further above, but at
-time of writing, it's uncertain whether Netscape might discard some of
-the cookies you could be writing back to disk.
-
-
-
-=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://www.altavista.com/sites/search/web';
- my $response = $browser->post( $url,
- [ 'q' => $word, # the Altavista query string
- '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_type eq 'text/html';
-
- if( $response->decoded_content =~ m{AltaVista found ([0-9,]+) results} ) {
- # The substring will be like "AltaVista found 2,345 results"
- 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<imdb.com> and ran a search on "Blade Runner", the URL you'd see
-in your browser window would be:
-
- http://us.imdb.com/Tsearch?title=Blade%20Runner&restrict=Movies+and+TV
-
-To run the same search with LWP, you'd use this idiom, which involves
-the URI class:
-
- use URI;
- my $url = URI->new( 'http://us.imdb.com/Tsearch' );
- # makes an object representing the URL
-
- $url->query_form( # And here the form data pairs:
- 'title' => 'Blade Runner',
- 'restrict' => 'Movies and TV',
- );
-
- 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.
-
-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. C<http://www.oreilly.com/catalog/perllwp/>
-
-=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
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/perlpod.pod b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/perlpod.pod
deleted file mode 100644
index 80c9ba134aa..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/perlpod.pod
+++ /dev/null
@@ -1,685 +0,0 @@
-
-=for comment
-This document is in Pod format. To read this, use a Pod formatter,
-like "perldoc perlpod".
-
-=head1 NAME
-
-perlpod - the Plain Old Documentation format
-
-=head1 DESCRIPTION
-
-Pod is a simple-to-use markup language used for writing documentation
-for Perl, Perl programs, and Perl modules.
-
-Translators are available for converting Pod to various formats
-like plain text, HTML, man pages, and more.
-
-Pod markup consists of three basic kinds of paragraphs:
-L<ordinary|/"Ordinary Paragraph">,
-L<verbatim|/"Verbatim Paragraph">, and
-L<command|/"Command Paragraph">.
-
-
-=head2 Ordinary Paragraph
-
-Most paragraphs in your documentation will be ordinary blocks
-of text, like this one. You can simply type in your text without
-any markup whatsoever, and with just a blank line before and
-after. When it gets formatted, it will undergo minimal formatting,
-like being rewrapped, probably put into a proportionally spaced
-font, and maybe even justified.
-
-You can use formatting codes in ordinary paragraphs, for B<bold>,
-I<italic>, C<code-style>, L<hyperlinks|perlfaq>, and more. Such
-codes are explained in the "L<Formatting Codes|/"Formatting Codes">"
-section, below.
-
-
-=head2 Verbatim Paragraph
-
-Verbatim paragraphs are usually used for presenting a codeblock or
-other text which does not require any special parsing or formatting,
-and which shouldn't be wrapped.
-
-A verbatim paragraph is distinguished by having its first character
-be a space or a tab. (And commonly, all its lines begin with spaces
-and/or tabs.) It should be reproduced exactly, with tabs assumed to
-be on 8-column boundaries. There are no special formatting codes,
-so you can't italicize or anything like that. A \ means \, and
-nothing else.
-
-
-=head2 Command Paragraph
-
-A command paragraph is used for special treatment of whole chunks
-of text, usually as headings or parts of lists.
-
-All command paragraphs (which are typically only one line long) start
-with "=", followed by an identifier, followed by arbitrary text that
-the command can use however it pleases. Currently recognized commands
-are
-
- =head1 Heading Text
- =head2 Heading Text
- =head3 Heading Text
- =head4 Heading Text
- =over indentlevel
- =item stuff
- =back
- =cut
- =pod
- =begin format
- =end format
- =for format text...
-
-To explain them each in detail:
-
-=over
-
-=item C<=head1 I<Heading Text>>
-
-=item C<=head2 I<Heading Text>>
-
-=item C<=head3 I<Heading Text>>
-
-=item C<=head4 I<Heading Text>>
-
-Head1 through head4 produce headings, head1 being the highest
-level. The text in the rest of this paragraph is the content of the
-heading. For example:
-
- =head2 Object Attributes
-
-The text "Object Attributes" comprises the heading there. (Note that
-head3 and head4 are recent additions, not supported in older Pod
-translators.) The text in these heading commands can use
-formatting codes, as seen here:
-
- =head2 Possible Values for C<$/>
-
-Such commands are explained in the
-"L<Formatting Codes|/"Formatting Codes">" section, below.
-
-=item C<=over I<indentlevel>>
-
-=item C<=item I<stuff...>>
-
-=item C<=back>
-
-Item, over, and back require a little more explanation: "=over" starts
-a region specifically for the generation of a list using "=item"
-commands, or for indenting (groups of) normal paragraphs. At the end
-of your list, use "=back" to end it. The I<indentlevel> option to
-"=over" indicates how far over to indent, generally in ems (where
-one em is the width of an "M" in the document's base font) or roughly
-comparable units; if there is no I<indentlevel> option, it defaults
-to four. (And some formatters may just ignore whatever I<indentlevel>
-you provide.) In the I<stuff> in C<=item I<stuff...>>, you may
-use formatting codes, as seen here:
-
- =item Using C<$|> to Control Buffering
-
-Such commands are explained in the
-"L<Formatting Codes|/"Formatting Codes">" section, below.
-
-Note also that there are some basic rules to using "=over" ...
-"=back" regions:
-
-=over
-
-=item *
-
-Don't use "=item"s outside of an "=over" ... "=back" region.
-
-=item *
-
-The first thing after the "=over" command should be an "=item", unless
-there aren't going to be any items at all in this "=over" ... "=back"
-region.
-
-=item *
-
-Don't put "=headI<n>" commands inside an "=over" ... "=back" region.
-
-=item *
-
-And perhaps most importantly, keep the items consistent: either use
-"=item *" for all of them, to produce bullets; or use "=item 1.",
-"=item 2.", etc., to produce numbered lists; or use "=item foo",
-"=item bar", etc. -- namely, things that look nothing like bullets or
-numbers.
-
-If you start with bullets or numbers, stick with them, as
-formatters use the first "=item" type to decide how to format the
-list.
-
-=back
-
-=item C<=cut>
-
-To end a Pod block, use a blank line,
-then a line beginning with "=cut", and a blank
-line after it. This lets Perl (and the Pod formatter) know that
-this is where Perl code is resuming. (The blank line before the "=cut"
-is not technically necessary, but many older Pod processors require it.)
-
-=item C<=pod>
-
-The "=pod" command by itself doesn't do much of anything, but it
-signals to Perl (and Pod formatters) that a Pod block starts here. A
-Pod block starts with I<any> command paragraph, so a "=pod" command is
-usually used just when you want to start a Pod block with an ordinary
-paragraph or a verbatim paragraph. For example:
-
- =item stuff()
-
- This function does stuff.
-
- =cut
-
- sub stuff {
- ...
- }
-
- =pod
-
- Remember to check its return value, as in:
-
- stuff() || die "Couldn't do stuff!";
-
- =cut
-
-=item C<=begin I<formatname>>
-
-=item C<=end I<formatname>>
-
-=item C<=for I<formatname> I<text...>>
-
-For, begin, and end will let you have regions of text/code/data that
-are not generally interpreted as normal Pod text, but are passed
-directly to particular formatters, or are otherwise special. A
-formatter that can use that format will use the region, otherwise it
-will be completely ignored.
-
-A command "=begin I<formatname>", some paragraphs, and a
-command "=end I<formatname>", mean that the text/data inbetween
-is meant for formatters that understand the special format
-called I<formatname>. For example,
-
- =begin html
-
- <hr> <img src="thang.png">
- <p> This is a raw HTML paragraph </p>
-
- =end html
-
-The command "=for I<formatname> I<text...>"
-specifies that the remainder of just this paragraph (starting
-right after I<formatname>) is in that special format.
-
- =for html <hr> <img src="thang.png">
- <p> This is a raw HTML paragraph </p>
-
-This means the same thing as the above "=begin html" ... "=end html"
-region.
-
-That is, with "=for", you can have only one paragraph's worth
-of text (i.e., the text in "=foo targetname text..."), but with
-"=begin targetname" ... "=end targetname", you can have any amount
-of stuff inbetween. (Note that there still must be a blank line
-after the "=begin" command and a blank line before the "=end"
-command.
-
-Here are some examples of how to use these:
-
- =begin html
-
- <br>Figure 1.<br><IMG SRC="figure1.png"><br>
-
- =end html
-
- =begin text
-
- ---------------
- | foo |
- | bar |
- ---------------
-
- ^^^^ Figure 1. ^^^^
-
- =end text
-
-Some format names that formatters currently are known to accept
-include "roff", "man", "latex", "tex", "text", and "html". (Some
-formatters will treat some of these as synonyms.)
-
-A format name of "comment" is common for just making notes (presumably
-to yourself) that won't appear in any formatted version of the Pod
-document:
-
- =for comment
- Make sure that all the available options are documented!
-
-Some I<formatnames> will require a leading colon (as in
-C<"=for :formatname">, or
-C<"=begin :formatname" ... "=end :formatname">),
-to signal that the text is not raw data, but instead I<is> Pod text
-(i.e., possibly containing formatting codes) that's just not for
-normal formatting (e.g., may not be a normal-use paragraph, but might
-be for formatting as a footnote).
-
-=back
-
-And don't forget, when using any command, that the command lasts up
-until the end of its I<paragraph>, not its line. So in the
-examples below, you can see that every command needs the blank
-line after it, to end its paragraph.
-
-Some examples of lists include:
-
- =over
-
- =item *
-
- First item
-
- =item *
-
- Second item
-
- =back
-
- =over
-
- =item Foo()
-
- Description of Foo function
-
- =item Bar()
-
- Description of Bar function
-
- =back
-
-
-=head2 Formatting Codes
-
-In ordinary paragraphs and in some command paragraphs, various
-formatting codes (a.k.a. "interior sequences") can be used:
-
-=for comment
- "interior sequences" is such an opaque term.
- Prefer "formatting codes" instead.
-
-=over
-
-=item C<IE<lt>textE<gt>> -- italic text
-
-Used for emphasis ("C<be IE<lt>careful!E<gt>>") and parameters
-("C<redo IE<lt>LABELE<gt>>")
-
-=item C<BE<lt>textE<gt>> -- bold text
-
-Used for switches ("C<perl's BE<lt>-nE<gt> switch>"), programs
-("C<some systems provide a BE<lt>chfnE<gt> for that>"),
-emphasis ("C<be BE<lt>careful!E<gt>>"), and so on
-("C<and that feature is known as BE<lt>autovivificationE<gt>>").
-
-=item C<CE<lt>codeE<gt>> -- code text
-
-Renders code in a typewriter font, or gives some other indication that
-this represents program text ("C<CE<lt>gmtime($^T)E<gt>>") or some other
-form of computerese ("C<CE<lt>drwxr-xr-xE<gt>>").
-
-=item C<LE<lt>nameE<gt>> -- a hyperlink
-
-There are various syntaxes, listed below. In the syntaxes given,
-C<text>, C<name>, and C<section> cannot contain the characters
-'/' and '|'; and any '<' or '>' should be matched.
-
-=over
-
-=item *
-
-C<LE<lt>nameE<gt>>
-
-Link to a Perl manual page (e.g., C<LE<lt>Net::PingE<gt>>). Note
-that C<name> should not contain spaces. This syntax
-is also occasionally used for references to UNIX man pages, as in
-C<LE<lt>crontab(5)E<gt>>.
-
-=item *
-
-C<LE<lt>name/"sec"E<gt>> or C<LE<lt>name/secE<gt>>
-
-Link to a section in other manual page. E.g.,
-C<LE<lt>perlsyn/"For Loops"E<gt>>
-
-=item *
-
-C<LE<lt>/"sec"E<gt>> or C<LE<lt>/secE<gt>> or C<LE<lt>"sec"E<gt>>
-
-Link to a section in this manual page. E.g.,
-C<LE<lt>/"Object Methods"E<gt>>
-
-=back
-
-A section is started by the named heading or item. For
-example, C<LE<lt>perlvar/$.E<gt>> or C<LE<lt>perlvar/"$."E<gt>> both
-link to the section started by "C<=item $.>" in perlvar. And
-C<LE<lt>perlsyn/For LoopsE<gt>> or C<LE<lt>perlsyn/"For Loops"E<gt>>
-both link to the section started by "C<=head2 For Loops>"
-in perlsyn.
-
-To control what text is used for display, you
-use "C<LE<lt>text|...E<gt>>", as in:
-
-=over
-
-=item *
-
-C<LE<lt>text|nameE<gt>>
-
-Link this text to that manual page. E.g.,
-C<LE<lt>Perl Error Messages|perldiagE<gt>>
-
-=item *
-
-C<LE<lt>text|name/"sec"E<gt>> or C<LE<lt>text|name/secE<gt>>
-
-Link this text to that section in that manual page. E.g.,
-C<LE<lt>SWITCH statements|perlsyn/"Basic BLOCKs and Switch
-Statements"E<gt>>
-
-=item *
-
-C<LE<lt>text|/"sec"E<gt>> or C<LE<lt>text|/secE<gt>>
-or C<LE<lt>text|"sec"E<gt>>
-
-Link this text to that section in this manual page. E.g.,
-C<LE<lt>the various attributes|/"Member Data"E<gt>>
-
-=back
-
-Or you can link to a web page:
-
-=over
-
-=item *
-
-C<LE<lt>scheme:...E<gt>>
-
-Links to an absolute URL. For example,
-C<LE<lt>http://www.perl.org/E<gt>>. But note
-that there is no corresponding C<LE<lt>text|scheme:...E<gt>> syntax, for
-various reasons.
-
-=back
-
-=item C<EE<lt>escapeE<gt>> -- a character escape
-
-Very similar to HTML/XML C<&I<foo>;> "entity references":
-
-=over
-
-=item *
-
-C<EE<lt>ltE<gt>> -- a literal E<lt> (less than)
-
-=item *
-
-C<EE<lt>gtE<gt>> -- a literal E<gt> (greater than)
-
-=item *
-
-C<EE<lt>verbarE<gt>> -- a literal | (I<ver>tical I<bar>)
-
-=item *
-
-C<EE<lt>solE<gt>> = a literal / (I<sol>idus)
-
-The above four are optional except in other formatting codes,
-notably C<LE<lt>...E<gt>>, and when preceded by a
-capital letter.
-
-=item *
-
-C<EE<lt>htmlnameE<gt>>
-
-Some non-numeric HTML entity name, such as C<EE<lt>eacuteE<gt>>,
-meaning the same thing as C<&eacute;> in HTML -- i.e., a lowercase
-e with an acute (/-shaped) accent.
-
-=item *
-
-C<EE<lt>numberE<gt>>
-
-The ASCII/Latin-1/Unicode character with that number. A
-leading "0x" means that I<number> is hex, as in
-C<EE<lt>0x201EE<gt>>. A leading "0" means that I<number> is octal,
-as in C<EE<lt>075E<gt>>. Otherwise I<number> is interpreted as being
-in decimal, as in C<EE<lt>181E<gt>>.
-
-Note that older Pod formatters might not recognize octal or
-hex numeric escapes, and that many formatters cannot reliably
-render characters above 255. (Some formatters may even have
-to use compromised renderings of Latin-1 characters, like
-rendering C<EE<lt>eacuteE<gt>> as just a plain "e".)
-
-=back
-
-=item C<FE<lt>filenameE<gt>> -- used for filenames
-
-Typically displayed in italics. Example: "C<FE<lt>.cshrcE<gt>>"
-
-=item C<SE<lt>textE<gt>> -- text contains non-breaking spaces
-
-This means that the words in I<text> should not be broken
-across lines. Example: S<C<SE<lt>$x ? $y : $zE<gt>>>.
-
-=item C<XE<lt>topic nameE<gt>> -- an index entry
-
-This is ignored by most formatters, but some may use it for building
-indexes. It always renders as empty-string.
-Example: C<XE<lt>absolutizing relative URLsE<gt>>
-
-=item C<ZE<lt>E<gt>> -- a null (zero-effect) formatting code
-
-This is rarely used. It's one way to get around using an
-EE<lt>...E<gt> code sometimes. For example, instead of
-"C<NEE<lt>ltE<gt>3>" (for "NE<lt>3") you could write
-"C<NZE<lt>E<gt>E<lt>3>" (the "ZE<lt>E<gt>" breaks up the "N" and
-the "E<lt>" so they can't be considered
-the part of a (fictitious) "NE<lt>...E<gt>" code.
-
-=for comment
- This was formerly explained as a "zero-width character". But it in
- most parser models, it parses to nothing at all, as opposed to parsing
- as if it were a E<zwnj> or E<zwj>, which are REAL zero-width characters.
- So "width" and "character" are exactly the wrong words.
-
-=back
-
-Most of the time, you will need only a single set of angle brackets to
-delimit the beginning and end of formatting codes. However,
-sometimes you will want to put a real right angle bracket (a
-greater-than sign, '>') inside of a formatting code. This is particularly
-common when using a formatting code to provide a different font-type for a
-snippet of code. As with all things in Perl, there is more than
-one way to do it. One way is to simply escape the closing bracket
-using an C<E> code:
-
- C<$a E<lt>=E<gt> $b>
-
-This will produce: "C<$a E<lt>=E<gt> $b>"
-
-A more readable, and perhaps more "plain" way is to use an alternate
-set of delimiters that doesn't require a single ">" to be escaped. With
-the Pod formatters that are standard starting with perl5.5.660, doubled
-angle brackets ("<<" and ">>") may be used I<if and only if there is
-whitespace right after the opening delimiter and whitespace right
-before the closing delimiter!> For example, the following will
-do the trick:
-
- C<< $a <=> $b >>
-
-In fact, you can use as many repeated angle-brackets as you like so
-long as you have the same number of them in the opening and closing
-delimiters, and make sure that whitespace immediately follows the last
-'<' of the opening delimiter, and immediately precedes the first '>'
-of the closing delimiter. (The whitespace is ignored.) So the
-following will also work:
-
- C<<< $a <=> $b >>>
- C<<<< $a <=> $b >>>>
-
-And they all mean exactly the same as this:
-
- C<$a E<lt>=E<gt> $b>
-
-As a further example, this means that if you wanted to put these bits of
-code in C<C> (code) style:
-
- open(X, ">>thing.dat") || die $!
- $foo->bar();
-
-you could do it like so:
-
- C<<< open(X, ">>thing.dat") || die $! >>>
- C<< $foo->bar(); >>
-
-which is presumably easier to read than the old way:
-
- C<open(X, "E<gt>E<gt>thing.dat") || die $!>
- C<$foo-E<gt>bar(); >>
-
-This is currently supported by pod2text (Pod::Text), pod2man (Pod::Man),
-and any other pod2xxx or Pod::Xxxx translators that use
-Pod::Parser 1.093 or later, or Pod::Tree 1.02 or later.
-
-=head2 The Intent
-
-The intent is simplicity of use, not power of expression. Paragraphs
-look like paragraphs (block format), so that they stand out
-visually, and so that I could run them through C<fmt> easily to reformat
-them (that's F7 in my version of B<vi>, or Esc Q in my version of
-B<emacs>). I wanted the translator to always leave the C<'> and C<`> and
-C<"> quotes alone, in verbatim mode, so I could slurp in a
-working program, shift it over four spaces, and have it print out, er,
-verbatim. And presumably in a monospace font.
-
-The Pod format is not necessarily sufficient for writing a book. Pod
-is just meant to be an idiot-proof common source for nroff, HTML,
-TeX, and other markup languages, as used for online
-documentation. Translators exist for B<pod2text>, B<pod2html>,
-B<pod2man> (that's for nroff(1) and troff(1)), B<pod2latex>, and
-B<pod2fm>. Various others are available in CPAN.
-
-
-=head2 Embedding Pods in Perl Modules
-
-You can embed Pod documentation in your Perl modules and scripts.
-Start your documentation with an empty line, a "=head1" command at the
-beginning, and end it with a "=cut" command and an empty line. Perl
-will ignore the Pod text. See any of the supplied library modules for
-examples. If you're going to put your Pod at the end of the file, and
-you're using an __END__ or __DATA__ cut mark, make sure to put an
-empty line there before the first Pod command.
-
- __END__
-
- =head1 NAME
-
- Time::Local - efficiently compute time from local and GMT time
-
-Without that empty line before the "=head1", many translators wouldn't
-have recognized the "=head1" as starting a Pod block.
-
-=head2 Hints for Writing Pod
-
-=over
-
-=item *
-
-The B<podchecker> command is provided for checking Pod syntax for errors
-and warnings. For example, it checks for completely blank lines in
-Pod blocks and for unknown commands and formatting codes. You should
-still also pass your document through one or more translators and proofread
-the result, or print out the result and proofread that. Some of the
-problems found may be bugs in the translators, which you may or may not
-wish to work around.
-
-=item *
-
-If you're more familiar with writing in HTML than with writing in Pod, you
-can try your hand at writing documentation in simple HTML, and converting
-it to Pod with the experimental L<Pod::HTML2Pod|Pod::HTML2Pod> module,
-(available in CPAN), and looking at the resulting code. The experimental
-L<Pod::PXML|Pod::PXML> module in CPAN might also be useful.
-
-=item *
-
-Many older Pod translators require the lines before every Pod
-command and after every Pod command (including "=cut"!) to be a blank
-line. Having something like this:
-
- # - - - - - - - - - - - -
- =item $firecracker->boom()
-
- This noisily detonates the firecracker object.
- =cut
- sub boom {
- ...
-
-...will make such Pod translators completely fail to see the Pod block
-at all.
-
-Instead, have it like this:
-
- # - - - - - - - - - - - -
-
- =item $firecracker->boom()
-
- This noisily detonates the firecracker object.
-
- =cut
-
- sub boom {
- ...
-
-=item *
-
-Some older Pod translators require paragraphs (including command
-paragraphs like "=head2 Functions") to be separated by I<completely>
-empty lines. If you have an apparently empty line with some spaces
-on it, this might not count as a separator for those translators, and
-that could cause odd formatting.
-
-=item *
-
-Older translators might add wording around an LE<lt>E<gt> link, so that
-C<LE<lt>Foo::BarE<gt>> may become "the Foo::Bar manpage", for example.
-So you shouldn't write things like C<the LE<lt>fooE<gt>
-documentation>, if you want the translated document to read sensibly
--- instead write C<the LE<lt>Foo::Bar|Foo::BarE<gt> documentation> or
-C<LE<lt>the Foo::Bar documentation|Foo::BarE<gt>>, to control how the
-link comes out.
-
-=item *
-
-Going past the 70th column in a verbatim block might be ungracefully
-wrapped by some formatters.
-
-=back
-
-=head1 SEE ALSO
-
-L<perlpodspec>, L<perlsyn/"PODs: Embedded Documentation">,
-L<perlnewmod>, L<perldoc>, L<pod2html>, L<pod2man>, L<podchecker>.
-
-=head1 AUTHOR
-
-Larry Wall, Sean M. Burke
-
-=cut
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/perlpodspec.pod b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/perlpodspec.pod
deleted file mode 100644
index 73872586343..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/perlpodspec.pod
+++ /dev/null
@@ -1,1876 +0,0 @@
-
-=head1 NAME
-
-perlpodspec - Plain Old Documentation: format specification and notes
-
-=head1 DESCRIPTION
-
-This document is detailed notes on the Pod markup language. Most
-people will only have to read L<perlpod|perlpod> to know how to write
-in Pod, but this document may answer some incidental questions to do
-with parsing and rendering Pod.
-
-In this document, "must" / "must not", "should" /
-"should not", and "may" have their conventional (cf. RFC 2119)
-meanings: "X must do Y" means that if X doesn't do Y, it's against
-this specification, and should really be fixed. "X should do Y"
-means that it's recommended, but X may fail to do Y, if there's a
-good reason. "X may do Y" is merely a note that X can do Y at
-will (although it is up to the reader to detect any connotation of
-"and I think it would be I<nice> if X did Y" versus "it wouldn't
-really I<bother> me if X did Y").
-
-Notably, when I say "the parser should do Y", the
-parser may fail to do Y, if the calling application explicitly
-requests that the parser I<not> do Y. I often phrase this as
-"the parser should, by default, do Y." This doesn't I<require>
-the parser to provide an option for turning off whatever
-feature Y is (like expanding tabs in verbatim paragraphs), although
-it implicates that such an option I<may> be provided.
-
-=head1 Pod Definitions
-
-Pod is embedded in files, typically Perl source files -- although you
-can write a file that's nothing but Pod.
-
-A B<line> in a file consists of zero or more non-newline characters,
-terminated by either a newline or the end of the file.
-
-A B<newline sequence> is usually a platform-dependent concept, but
-Pod parsers should understand it to mean any of CR (ASCII 13), LF
-(ASCII 10), or a CRLF (ASCII 13 followed immediately by ASCII 10), in
-addition to any other system-specific meaning. The first CR/CRLF/LF
-sequence in the file may be used as the basis for identifying the
-newline sequence for parsing the rest of the file.
-
-A B<blank line> is a line consisting entirely of zero or more spaces
-(ASCII 32) or tabs (ASCII 9), and terminated by a newline or end-of-file.
-A B<non-blank line> is a line containing one or more characters other
-than space or tab (and terminated by a newline or end-of-file).
-
-(I<Note:> Many older Pod parsers did not accept a line consisting of
-spaces/tabs and then a newline as a blank line -- the only lines they
-considered blank were lines consisting of I<no characters at all>,
-terminated by a newline.)
-
-B<Whitespace> is used in this document as a blanket term for spaces,
-tabs, and newline sequences. (By itself, this term usually refers
-to literal whitespace. That is, sequences of whitespace characters
-in Pod source, as opposed to "EE<lt>32>", which is a formatting
-code that I<denotes> a whitespace character.)
-
-A B<Pod parser> is a module meant for parsing Pod (regardless of
-whether this involves calling callbacks or building a parse tree or
-directly formatting it). A B<Pod formatter> (or B<Pod translator>)
-is a module or program that converts Pod to some other format (HTML,
-plaintext, TeX, PostScript, RTF). A B<Pod processor> might be a
-formatter or translator, or might be a program that does something
-else with the Pod (like wordcounting it, scanning for index points,
-etc.).
-
-Pod content is contained in B<Pod blocks>. A Pod block starts with a
-line that matches <m/\A=[a-zA-Z]/>, and continues up to the next line
-that matches C<m/\A=cut/> -- or up to the end of the file, if there is
-no C<m/\A=cut/> line.
-
-=for comment
- The current perlsyn says:
- [beginquote]
- Note that pod translators should look at only paragraphs beginning
- with a pod directive (it makes parsing easier), whereas the compiler
- actually knows to look for pod escapes even in the middle of a
- paragraph. This means that the following secret stuff will be ignored
- by both the compiler and the translators.
- $a=3;
- =secret stuff
- warn "Neither POD nor CODE!?"
- =cut back
- print "got $a\n";
- You probably shouldn't rely upon the warn() being podded out forever.
- Not all pod translators are well-behaved in this regard, and perhaps
- the compiler will become pickier.
- [endquote]
- I think that those paragraphs should just be removed; paragraph-based
- parsing seems to have been largely abandoned, because of the hassle
- with non-empty blank lines messing up what people meant by "paragraph".
- Even if the "it makes parsing easier" bit were especially true,
- it wouldn't be worth the confusion of having perl and pod2whatever
- actually disagree on what can constitute a Pod block.
-
-Within a Pod block, there are B<Pod paragraphs>. A Pod paragraph
-consists of non-blank lines of text, separated by one or more blank
-lines.
-
-For purposes of Pod processing, there are four types of paragraphs in
-a Pod block:
-
-=over
-
-=item *
-
-A command paragraph (also called a "directive"). The first line of
-this paragraph must match C<m/\A=[a-zA-Z]/>. Command paragraphs are
-typically one line, as in:
-
- =head1 NOTES
-
- =item *
-
-But they may span several (non-blank) lines:
-
- =for comment
- Hm, I wonder what it would look like if
- you tried to write a BNF for Pod from this.
-
- =head3 Dr. Strangelove, or: How I Learned to
- Stop Worrying and Love the Bomb
-
-I<Some> command paragraphs allow formatting codes in their content
-(i.e., after the part that matches C<m/\A=[a-zA-Z]\S*\s*/>), as in:
-
- =head1 Did You Remember to C<use strict;>?
-
-In other words, the Pod processing handler for "head1" will apply the
-same processing to "Did You Remember to CE<lt>use strict;>?" that it
-would to an ordinary paragraph -- i.e., formatting codes (like
-"CE<lt>...>") are parsed and presumably formatted appropriately, and
-whitespace in the form of literal spaces and/or tabs is not
-significant.
-
-=item *
-
-A B<verbatim paragraph>. The first line of this paragraph must be a
-literal space or tab, and this paragraph must not be inside a "=begin
-I<identifier>", ... "=end I<identifier>" sequence unless
-"I<identifier>" begins with a colon (":"). That is, if a paragraph
-starts with a literal space or tab, but I<is> inside a
-"=begin I<identifier>", ... "=end I<identifier>" region, then it's
-a data paragraph, unless "I<identifier>" begins with a colon.
-
-Whitespace I<is> significant in verbatim paragraphs (although, in
-processing, tabs are probably expanded).
-
-=item *
-
-An B<ordinary paragraph>. A paragraph is an ordinary paragraph
-if its first line matches neither C<m/\A=[a-zA-Z]/> nor
-C<m/\A[ \t]/>, I<and> if it's not inside a "=begin I<identifier>",
-... "=end I<identifier>" sequence unless "I<identifier>" begins with
-a colon (":").
-
-=item *
-
-A B<data paragraph>. This is a paragraph that I<is> inside a "=begin
-I<identifier>" ... "=end I<identifier>" sequence where
-"I<identifier>" does I<not> begin with a literal colon (":"). In
-some sense, a data paragraph is not part of Pod at all (i.e.,
-effectively it's "out-of-band"), since it's not subject to most kinds
-of Pod parsing; but it is specified here, since Pod
-parsers need to be able to call an event for it, or store it in some
-form in a parse tree, or at least just parse I<around> it.
-
-=back
-
-For example: consider the following paragraphs:
-
- # <- that's the 0th column
-
- =head1 Foo
-
- Stuff
-
- $foo->bar
-
- =cut
-
-Here, "=head1 Foo" and "=cut" are command paragraphs because the first
-line of each matches C<m/\A=[a-zA-Z]/>. "I<[space][space]>$foo->bar"
-is a verbatim paragraph, because its first line starts with a literal
-whitespace character (and there's no "=begin"..."=end" region around).
-
-The "=begin I<identifier>" ... "=end I<identifier>" commands stop
-paragraphs that they surround from being parsed as data or verbatim
-paragraphs, if I<identifier> doesn't begin with a colon. This
-is discussed in detail in the section
-L</About Data Paragraphs and "=beginE<sol>=end" Regions>.
-
-=head1 Pod Commands
-
-This section is intended to supplement and clarify the discussion in
-L<perlpod/"Command Paragraph">. These are the currently recognized
-Pod commands:
-
-=over
-
-=item "=head1", "=head2", "=head3", "=head4"
-
-This command indicates that the text in the remainder of the paragraph
-is a heading. That text may contain formatting codes. Examples:
-
- =head1 Object Attributes
-
- =head3 What B<Not> to Do!
-
-=item "=pod"
-
-This command indicates that this paragraph begins a Pod block. (If we
-are already in the middle of a Pod block, this command has no effect at
-all.) If there is any text in this command paragraph after "=pod",
-it must be ignored. Examples:
-
- =pod
-
- This is a plain Pod paragraph.
-
- =pod This text is ignored.
-
-=item "=cut"
-
-This command indicates that this line is the end of this previously
-started Pod block. If there is any text after "=cut" on the line, it must be
-ignored. Examples:
-
- =cut
-
- =cut The documentation ends here.
-
- =cut
- # This is the first line of program text.
- sub foo { # This is the second.
-
-It is an error to try to I<start> a Pod black with a "=cut" command. In
-that case, the Pod processor must halt parsing of the input file, and
-must by default emit a warning.
-
-=item "=over"
-
-This command indicates that this is the start of a list/indent
-region. If there is any text following the "=over", it must consist
-of only a nonzero positive numeral. The semantics of this numeral is
-explained in the L</"About =over...=back Regions"> section, further
-below. Formatting codes are not expanded. Examples:
-
- =over 3
-
- =over 3.5
-
- =over
-
-=item "=item"
-
-This command indicates that an item in a list begins here. Formatting
-codes are processed. The semantics of the (optional) text in the
-remainder of this paragraph are
-explained in the L</"About =over...=back Regions"> section, further
-below. Examples:
-
- =item
-
- =item *
-
- =item *
-
- =item 14
-
- =item 3.
-
- =item C<< $thing->stuff(I<dodad>) >>
-
- =item For transporting us beyond seas to be tried for pretended
- offenses
-
- =item He is at this time transporting large armies of foreign
- mercenaries to complete the works of death, desolation and
- tyranny, already begun with circumstances of cruelty and perfidy
- scarcely paralleled in the most barbarous ages, and totally
- unworthy the head of a civilized nation.
-
-=item "=back"
-
-This command indicates that this is the end of the region begun
-by the most recent "=over" command. It permits no text after the
-"=back" command.
-
-=item "=begin formatname"
-
-This marks the following paragraphs (until the matching "=end
-formatname") as being for some special kind of processing. Unless
-"formatname" begins with a colon, the contained non-command
-paragraphs are data paragraphs. But if "formatname" I<does> begin
-with a colon, then non-command paragraphs are ordinary paragraphs
-or data paragraphs. This is discussed in detail in the section
-L</About Data Paragraphs and "=beginE<sol>=end" Regions>.
-
-It is advised that formatnames match the regexp
-C<m/\A:?[-a-zA-Z0-9_]+\z/>. Implementors should anticipate future
-expansion in the semantics and syntax of the first parameter
-to "=begin"/"=end"/"=for".
-
-=item "=end formatname"
-
-This marks the end of the region opened by the matching
-"=begin formatname" region. If "formatname" is not the formatname
-of the most recent open "=begin formatname" region, then this
-is an error, and must generate an error message. This
-is discussed in detail in the section
-L</About Data Paragraphs and "=beginE<sol>=end" Regions>.
-
-=item "=for formatname text..."
-
-This is synonymous with:
-
- =begin formatname
-
- text...
-
- =end formatname
-
-That is, it creates a region consisting of a single paragraph; that
-paragraph is to be treated as a normal paragraph if "formatname"
-begins with a ":"; if "formatname" I<doesn't> begin with a colon,
-then "text..." will constitute a data paragraph. There is no way
-to use "=for formatname text..." to express "text..." as a verbatim
-paragraph.
-
-=back
-
-If a Pod processor sees any command other than the ones listed
-above (like "=head", or "=haed1", or "=stuff", or "=cuttlefish",
-or "=w123"), that processor must by default treat this as an
-error. It must not process the paragraph beginning with that
-command, must by default warn of this as an error, and may
-abort the parse. A Pod parser may allow a way for particular
-applications to add to the above list of known commands, and to
-stipulate, for each additional command, whether formatting
-codes should be processed.
-
-Future versions of this specification may add additional
-commands.
-
-
-
-=head1 Pod Formatting Codes
-
-(Note that in previous drafts of this document and of perlpod,
-formatting codes were referred to as "interior sequences", and
-this term may still be found in the documentation for Pod parsers,
-and in error messages from Pod processors.)
-
-There are two syntaxes for formatting codes:
-
-=over
-
-=item *
-
-A formatting code starts with a capital letter (just US-ASCII [A-Z])
-followed by a "<", any number of characters, and ending with the first
-matching ">". Examples:
-
- That's what I<you> think!
-
- What's C<dump()> for?
-
- X<C<chmod> and C<unlink()> Under Different Operating Systems>
-
-=item *
-
-A formatting code starts with a capital letter (just US-ASCII [A-Z])
-followed by two or more "<"'s, one or more whitespace characters,
-any number of characters, one or more whitespace characters,
-and ending with the first matching sequence of two or more ">"'s, where
-the number of ">"'s equals the number of "<"'s in the opening of this
-formatting code. Examples:
-
- That's what I<< you >> think!
-
- C<<< open(X, ">>thing.dat") || die $! >>>
-
- B<< $foo->bar(); >>
-
-With this syntax, the whitespace character(s) after the "CE<lt><<"
-and before the ">>" (or whatever letter) are I<not> renderable -- they
-do not signify whitespace, are merely part of the formatting codes
-themselves. That is, these are all synonymous:
-
- C<thing>
- C<< thing >>
- C<< thing >>
- C<<< thing >>>
- C<<<<
- thing
- >>>>
-
-and so on.
-
-=back
-
-In parsing Pod, a notably tricky part is the correct parsing of
-(potentially nested!) formatting codes. Implementors should
-consult the code in the C<parse_text> routine in Pod::Parser as an
-example of a correct implementation.
-
-=over
-
-=item C<IE<lt>textE<gt>> -- italic text
-
-See the brief discussion in L<perlpod/"Formatting Codes">.
-
-=item C<BE<lt>textE<gt>> -- bold text
-
-See the brief discussion in L<perlpod/"Formatting Codes">.
-
-=item C<CE<lt>codeE<gt>> -- code text
-
-See the brief discussion in L<perlpod/"Formatting Codes">.
-
-=item C<FE<lt>filenameE<gt>> -- style for filenames
-
-See the brief discussion in L<perlpod/"Formatting Codes">.
-
-=item C<XE<lt>topic nameE<gt>> -- an index entry
-
-See the brief discussion in L<perlpod/"Formatting Codes">.
-
-This code is unusual in that most formatters completely discard
-this code and its content. Other formatters will render it with
-invisible codes that can be used in building an index of
-the current document.
-
-=item C<ZE<lt>E<gt>> -- a null (zero-effect) formatting code
-
-Discussed briefly in L<perlpod/"Formatting Codes">.
-
-This code is unusual is that it should have no content. That is,
-a processor may complain if it sees C<ZE<lt>potatoesE<gt>>. Whether
-or not it complains, the I<potatoes> text should ignored.
-
-=item C<LE<lt>nameE<gt>> -- a hyperlink
-
-The complicated syntaxes of this code are discussed at length in
-L<perlpod/"Formatting Codes">, and implementation details are
-discussed below, in L</"About LE<lt>...E<gt> Codes">. Parsing the
-contents of LE<lt>content> is tricky. Notably, the content has to be
-checked for whether it looks like a URL, or whether it has to be split
-on literal "|" and/or "/" (in the right order!), and so on,
-I<before> EE<lt>...> codes are resolved.
-
-=item C<EE<lt>escapeE<gt>> -- a character escape
-
-See L<perlpod/"Formatting Codes">, and several points in
-L</Notes on Implementing Pod Processors>.
-
-=item C<SE<lt>textE<gt>> -- text contains non-breaking spaces
-
-This formatting code is syntactically simple, but semantically
-complex. What it means is that each space in the printable
-content of this code signifies a nonbreaking space.
-
-Consider:
-
- C<$x ? $y : $z>
-
- S<C<$x ? $y : $z>>
-
-Both signify the monospace (c[ode] style) text consisting of
-"$x", one space, "?", one space, ":", one space, "$z". The
-difference is that in the latter, with the S code, those spaces
-are not "normal" spaces, but instead are nonbreaking spaces.
-
-=back
-
-
-If a Pod processor sees any formatting code other than the ones
-listed above (as in "NE<lt>...>", or "QE<lt>...>", etc.), that
-processor must by default treat this as an error.
-A Pod parser may allow a way for particular
-applications to add to the above list of known formatting codes;
-a Pod parser might even allow a way to stipulate, for each additional
-command, whether it requires some form of special processing, as
-LE<lt>...> does.
-
-Future versions of this specification may add additional
-formatting codes.
-
-Historical note: A few older Pod processors would not see a ">" as
-closing a "CE<lt>" code, if the ">" was immediately preceded by
-a "-". This was so that this:
-
- C<$foo->bar>
-
-would parse as equivalent to this:
-
- C<$foo-E<lt>bar>
-
-instead of as equivalent to a "C" formatting code containing
-only "$foo-", and then a "bar>" outside the "C" formatting code. This
-problem has since been solved by the addition of syntaxes like this:
-
- C<< $foo->bar >>
-
-Compliant parsers must not treat "->" as special.
-
-Formatting codes absolutely cannot span paragraphs. If a code is
-opened in one paragraph, and no closing code is found by the end of
-that paragraph, the Pod parser must close that formatting code,
-and should complain (as in "Unterminated I code in the paragraph
-starting at line 123: 'Time objects are not...'"). So these
-two paragraphs:
-
- I<I told you not to do this!
-
- Don't make me say it again!>
-
-...must I<not> be parsed as two paragraphs in italics (with the I
-code starting in one paragraph and starting in another.) Instead,
-the first paragraph should generate a warning, but that aside, the
-above code must parse as if it were:
-
- I<I told you not to do this!>
-
- Don't make me say it again!E<gt>
-
-(In SGMLish jargon, all Pod commands are like block-level
-elements, whereas all Pod formatting codes are like inline-level
-elements.)
-
-
-
-=head1 Notes on Implementing Pod Processors
-
-The following is a long section of miscellaneous requirements
-and suggestions to do with Pod processing.
-
-=over
-
-=item *
-
-Pod formatters should tolerate lines in verbatim blocks that are of
-any length, even if that means having to break them (possibly several
-times, for very long lines) to avoid text running off the side of the
-page. Pod formatters may warn of such line-breaking. Such warnings
-are particularly appropriate for lines are over 100 characters long, which
-are usually not intentional.
-
-=item *
-
-Pod parsers must recognize I<all> of the three well-known newline
-formats: CR, LF, and CRLF. See L<perlport|perlport>.
-
-=item *
-
-Pod parsers should accept input lines that are of any length.
-
-=item *
-
-Since Perl recognizes a Unicode Byte Order Mark at the start of files
-as signaling that the file is Unicode encoded as in UTF-16 (whether
-big-endian or little-endian) or UTF-8, Pod parsers should do the
-same. Otherwise, the character encoding should be understood as
-being UTF-8 if the first highbit byte sequence in the file seems
-valid as a UTF-8 sequence, or otherwise as Latin-1.
-
-Future versions of this specification may specify
-how Pod can accept other encodings. Presumably treatment of other
-encodings in Pod parsing would be as in XML parsing: whatever the
-encoding declared by a particular Pod file, content is to be
-stored in memory as Unicode characters.
-
-=item *
-
-The well known Unicode Byte Order Marks are as follows: if the
-file begins with the two literal byte values 0xFE 0xFF, this is
-the BOM for big-endian UTF-16. If the file begins with the two
-literal byte value 0xFF 0xFE, this is the BOM for little-endian
-UTF-16. If the file begins with the three literal byte values
-0xEF 0xBB 0xBF, this is the BOM for UTF-8.
-
-=for comment
- use bytes; print map sprintf(" 0x%02X", ord $_), split '', "\x{feff}";
- 0xEF 0xBB 0xBF
-
-=for comment
- If toke.c is modified to support UTF32, add mention of those here.
-
-=item *
-
-A naive but sufficient heuristic for testing the first highbit
-byte-sequence in a BOM-less file (whether in code or in Pod!), to see
-whether that sequence is valid as UTF-8 (RFC 2279) is to check whether
-that the first byte in the sequence is in the range 0xC0 - 0xFD
-I<and> whether the next byte is in the range
-0x80 - 0xBF. If so, the parser may conclude that this file is in
-UTF-8, and all highbit sequences in the file should be assumed to
-be UTF-8. Otherwise the parser should treat the file as being
-in Latin-1. In the unlikely circumstance that the first highbit
-sequence in a truly non-UTF-8 file happens to appear to be UTF-8, one
-can cater to our heuristic (as well as any more intelligent heuristic)
-by prefacing that line with a comment line containing a highbit
-sequence that is clearly I<not> valid as UTF-8. A line consisting
-of simply "#", an e-acute, and any non-highbit byte,
-is sufficient to establish this file's encoding.
-
-=for comment
- If/WHEN some brave soul makes these heuristics into a generic
- text-file class (or PerlIO layer?), we can presumably delete
- mention of these icky details from this file, and can instead
- tell people to just use appropriate class/layer.
- Auto-recognition of newline sequences would be another desirable
- feature of such a class/layer.
- HINT HINT HINT.
-
-=for comment
- "The probability that a string of characters
- in any other encoding appears as valid UTF-8 is low" - RFC2279
-
-=item *
-
-This document's requirements and suggestions about encodings
-do not apply to Pod processors running on non-ASCII platforms,
-notably EBCDIC platforms.
-
-=item *
-
-Pod processors must treat a "=for [label] [content...]" paragraph as
-meaning the same thing as a "=begin [label]" paragraph, content, and
-an "=end [label]" paragraph. (The parser may conflate these two
-constructs, or may leave them distinct, in the expectation that the
-formatter will nevertheless treat them the same.)
-
-=item *
-
-When rendering Pod to a format that allows comments (i.e., to nearly
-any format other than plaintext), a Pod formatter must insert comment
-text identifying its name and version number, and the name and
-version numbers of any modules it might be using to process the Pod.
-Minimal examples:
-
- %% POD::Pod2PS v3.14159, using POD::Parser v1.92
-
- <!-- Pod::HTML v3.14159, using POD::Parser v1.92 -->
-
- {\doccomm generated by Pod::Tree::RTF 3.14159 using Pod::Tree 1.08}
-
- .\" Pod::Man version 3.14159, using POD::Parser version 1.92
-
-Formatters may also insert additional comments, including: the
-release date of the Pod formatter program, the contact address for
-the author(s) of the formatter, the current time, the name of input
-file, the formatting options in effect, version of Perl used, etc.
-
-Formatters may also choose to note errors/warnings as comments,
-besides or instead of emitting them otherwise (as in messages to
-STDERR, or C<die>ing).
-
-=item *
-
-Pod parsers I<may> emit warnings or error messages ("Unknown E code
-EE<lt>zslig>!") to STDERR (whether through printing to STDERR, or
-C<warn>ing/C<carp>ing, or C<die>ing/C<croak>ing), but I<must> allow
-suppressing all such STDERR output, and instead allow an option for
-reporting errors/warnings
-in some other way, whether by triggering a callback, or noting errors
-in some attribute of the document object, or some similarly unobtrusive
-mechanism -- or even by appending a "Pod Errors" section to the end of
-the parsed form of the document.
-
-=item *
-
-In cases of exceptionally aberrant documents, Pod parsers may abort the
-parse. Even then, using C<die>ing/C<croak>ing is to be avoided; where
-possible, the parser library may simply close the input file
-and add text like "*** Formatting Aborted ***" to the end of the
-(partial) in-memory document.
-
-=item *
-
-In paragraphs where formatting codes (like EE<lt>...>, BE<lt>...>)
-are understood (i.e., I<not> verbatim paragraphs, but I<including>
-ordinary paragraphs, and command paragraphs that produce renderable
-text, like "=head1"), literal whitespace should generally be considered
-"insignificant", in that one literal space has the same meaning as any
-(nonzero) number of literal spaces, literal newlines, and literal tabs
-(as long as this produces no blank lines, since those would terminate
-the paragraph). Pod parsers should compact literal whitespace in each
-processed paragraph, but may provide an option for overriding this
-(since some processing tasks do not require it), or may follow
-additional special rules (for example, specially treating
-period-space-space or period-newline sequences).
-
-=item *
-
-Pod parsers should not, by default, try to coerce apostrophe (') and
-quote (") into smart quotes (little 9's, 66's, 99's, etc), nor try to
-turn backtick (`) into anything else but a single backtick character
-(distinct from an openquote character!), nor "--" into anything but
-two minus signs. They I<must never> do any of those things to text
-in CE<lt>...> formatting codes, and never I<ever> to text in verbatim
-paragraphs.
-
-=item *
-
-When rendering Pod to a format that has two kinds of hyphens (-), one
-that's a nonbreaking hyphen, and another that's a breakable hyphen
-(as in "object-oriented", which can be split across lines as
-"object-", newline, "oriented"), formatters are encouraged to
-generally translate "-" to nonbreaking hyphen, but may apply
-heuristics to convert some of these to breaking hyphens.
-
-=item *
-
-Pod formatters should make reasonable efforts to keep words of Perl
-code from being broken across lines. For example, "Foo::Bar" in some
-formatting systems is seen as eligible for being broken across lines
-as "Foo::" newline "Bar" or even "Foo::-" newline "Bar". This should
-be avoided where possible, either by disabling all line-breaking in
-mid-word, or by wrapping particular words with internal punctuation
-in "don't break this across lines" codes (which in some formats may
-not be a single code, but might be a matter of inserting non-breaking
-zero-width spaces between every pair of characters in a word.)
-
-=item *
-
-Pod parsers should, by default, expand tabs in verbatim paragraphs as
-they are processed, before passing them to the formatter or other
-processor. Parsers may also allow an option for overriding this.
-
-=item *
-
-Pod parsers should, by default, remove newlines from the end of
-ordinary and verbatim paragraphs before passing them to the
-formatter. For example, while the paragraph you're reading now
-could be considered, in Pod source, to end with (and contain)
-the newline(s) that end it, it should be processed as ending with
-(and containing) the period character that ends this sentence.
-
-=item *
-
-Pod parsers, when reporting errors, should make some effort to report
-an approximate line number ("Nested EE<lt>>'s in Paragraph #52, near
-line 633 of Thing/Foo.pm!"), instead of merely noting the paragraph
-number ("Nested EE<lt>>'s in Paragraph #52 of Thing/Foo.pm!"). Where
-this is problematic, the paragraph number should at least be
-accompanied by an excerpt from the paragraph ("Nested EE<lt>>'s in
-Paragraph #52 of Thing/Foo.pm, which begins 'Read/write accessor for
-the CE<lt>interest rate> attribute...'").
-
-=item *
-
-Pod parsers, when processing a series of verbatim paragraphs one
-after another, should consider them to be one large verbatim
-paragraph that happens to contain blank lines. I.e., these two
-lines, which have a blank line between them:
-
- use Foo;
-
- print Foo->VERSION
-
-should be unified into one paragraph ("\tuse Foo;\n\n\tprint
-Foo->VERSION") before being passed to the formatter or other
-processor. Parsers may also allow an option for overriding this.
-
-While this might be too cumbersome to implement in event-based Pod
-parsers, it is straightforward for parsers that return parse trees.
-
-=item *
-
-Pod formatters, where feasible, are advised to avoid splitting short
-verbatim paragraphs (under twelve lines, say) across pages.
-
-=item *
-
-Pod parsers must treat a line with only spaces and/or tabs on it as a
-"blank line" such as separates paragraphs. (Some older parsers
-recognized only two adjacent newlines as a "blank line" but would not
-recognize a newline, a space, and a newline, as a blank line. This
-is noncompliant behavior.)
-
-=item *
-
-Authors of Pod formatters/processors should make every effort to
-avoid writing their own Pod parser. There are already several in
-CPAN, with a wide range of interface styles -- and one of them,
-Pod::Parser, comes with modern versions of Perl.
-
-=item *
-
-Characters in Pod documents may be conveyed either as literals, or by
-number in EE<lt>n> codes, or by an equivalent mnemonic, as in
-EE<lt>eacute> which is exactly equivalent to EE<lt>233>.
-
-Characters in the range 32-126 refer to those well known US-ASCII
-characters (also defined there by Unicode, with the same meaning),
-which all Pod formatters must render faithfully. Characters
-in the ranges 0-31 and 127-159 should not be used (neither as
-literals, nor as EE<lt>number> codes), except for the
-literal byte-sequences for newline (13, 13 10, or 10), and tab (9).
-
-Characters in the range 160-255 refer to Latin-1 characters (also
-defined there by Unicode, with the same meaning). Characters above
-255 should be understood to refer to Unicode characters.
-
-=item *
-
-Be warned
-that some formatters cannot reliably render characters outside 32-126;
-and many are able to handle 32-126 and 160-255, but nothing above
-255.
-
-=item *
-
-Besides the well-known "EE<lt>lt>" and "EE<lt>gt>" codes for
-less-than and greater-than, Pod parsers must understand "EE<lt>sol>"
-for "/" (solidus, slash), and "EE<lt>verbar>" for "|" (vertical bar,
-pipe). Pod parsers should also understand "EE<lt>lchevron>" and
-"EE<lt>rchevron>" as legacy codes for characters 171 and 187, i.e.,
-"left-pointing double angle quotation mark" = "left pointing
-guillemet" and "right-pointing double angle quotation mark" = "right
-pointing guillemet". (These look like little "<<" and ">>", and they
-are now preferably expressed with the HTML/XHTML codes "EE<lt>laquo>"
-and "EE<lt>raquo>".)
-
-=item *
-
-Pod parsers should understand all "EE<lt>html>" codes as defined
-in the entity declarations in the most recent XHTML specification at
-C<www.W3.org>. Pod parsers must understand at least the entities
-that define characters in the range 160-255 (Latin-1). Pod parsers,
-when faced with some unknown "EE<lt>I<identifier>>" code,
-shouldn't simply replace it with nullstring (by default, at least),
-but may pass it through as a string consisting of the literal characters
-E, less-than, I<identifier>, greater-than. Or Pod parsers may offer the
-alternative option of processing such unknown
-"EE<lt>I<identifier>>" codes by firing an event especially
-for such codes, or by adding a special node-type to the in-memory
-document tree. Such "EE<lt>I<identifier>>" may have special meaning
-to some processors, or some processors may choose to add them to
-a special error report.
-
-=item *
-
-Pod parsers must also support the XHTML codes "EE<lt>quot>" for
-character 34 (doublequote, "), "EE<lt>amp>" for character 38
-(ampersand, &), and "EE<lt>apos>" for character 39 (apostrophe, ').
-
-=item *
-
-Note that in all cases of "EE<lt>whatever>", I<whatever> (whether
-an htmlname, or a number in any base) must consist only of
-alphanumeric characters -- that is, I<whatever> must watch
-C<m/\A\w+\z/>. So "EE<lt> 0 1 2 3 >" is invalid, because
-it contains spaces, which aren't alphanumeric characters. This
-presumably does not I<need> special treatment by a Pod processor;
-" 0 1 2 3 " doesn't look like a number in any base, so it would
-presumably be looked up in the table of HTML-like names. Since
-there isn't (and cannot be) an HTML-like entity called " 0 1 2 3 ",
-this will be treated as an error. However, Pod processors may
-treat "EE<lt> 0 1 2 3 >" or "EE<lt>e-acute>" as I<syntactically>
-invalid, potentially earning a different error message than the
-error message (or warning, or event) generated by a merely unknown
-(but theoretically valid) htmlname, as in "EE<lt>qacute>"
-[sic]. However, Pod parsers are not required to make this
-distinction.
-
-=item *
-
-Note that EE<lt>number> I<must not> be interpreted as simply
-"codepoint I<number> in the current/native character set". It always
-means only "the character represented by codepoint I<number> in
-Unicode." (This is identical to the semantics of &#I<number>; in XML.)
-
-This will likely require many formatters to have tables mapping from
-treatable Unicode codepoints (such as the "\xE9" for the e-acute
-character) to the escape sequences or codes necessary for conveying
-such sequences in the target output format. A converter to *roff
-would, for example know that "\xE9" (whether conveyed literally, or via
-a EE<lt>...> sequence) is to be conveyed as "e\\*'".
-Similarly, a program rendering Pod in a Mac OS application window, would
-presumably need to know that "\xE9" maps to codepoint 142 in MacRoman
-encoding that (at time of writing) is native for Mac OS. Such
-Unicode2whatever mappings are presumably already widely available for
-common output formats. (Such mappings may be incomplete! Implementers
-are not expected to bend over backwards in an attempt to render
-Cherokee syllabics, Etruscan runes, Byzantine musical symbols, or any
-of the other weird things that Unicode can encode.) And
-if a Pod document uses a character not found in such a mapping, the
-formatter should consider it an unrenderable character.
-
-=item *
-
-If, surprisingly, the implementor of a Pod formatter can't find a
-satisfactory pre-existing table mapping from Unicode characters to
-escapes in the target format (e.g., a decent table of Unicode
-characters to *roff escapes), it will be necessary to build such a
-table. If you are in this circumstance, you should begin with the
-characters in the range 0x00A0 - 0x00FF, which is mostly the heavily
-used accented characters. Then proceed (as patience permits and
-fastidiousness compels) through the characters that the (X)HTML
-standards groups judged important enough to merit mnemonics
-for. These are declared in the (X)HTML specifications at the
-www.W3.org site. At time of writing (September 2001), the most recent
-entity declaration files are:
-
- http://www.w3.org/TR/xhtml1/DTD/xhtml-lat1.ent
- http://www.w3.org/TR/xhtml1/DTD/xhtml-special.ent
- http://www.w3.org/TR/xhtml1/DTD/xhtml-symbol.ent
-
-Then you can progress through any remaining notable Unicode characters
-in the range 0x2000-0x204D (consult the character tables at
-www.unicode.org), and whatever else strikes your fancy. For example,
-in F<xhtml-symbol.ent>, there is the entry:
-
- <!ENTITY infin "&#8734;"> <!-- infinity, U+221E ISOtech -->
-
-While the mapping "infin" to the character "\x{221E}" will (hopefully)
-have been already handled by the Pod parser, the presence of the
-character in this file means that it's reasonably important enough to
-include in a formatter's table that maps from notable Unicode characters
-to the codes necessary for rendering them. So for a Unicode-to-*roff
-mapping, for example, this would merit the entry:
-
- "\x{221E}" => '\(in',
-
-It is eagerly hoped that in the future, increasing numbers of formats
-(and formatters) will support Unicode characters directly (as (X)HTML
-does with C<&infin;>, C<&#8734;>, or C<&#x221E;>), reducing the need
-for idiosyncratic mappings of Unicode-to-I<my_escapes>.
-
-=item *
-
-It is up to individual Pod formatter to display good judgment when
-confronted with an unrenderable character (which is distinct from an
-unknown EE<lt>thing> sequence that the parser couldn't resolve to
-anything, renderable or not). It is good practice to map Latin letters
-with diacritics (like "EE<lt>eacute>"/"EE<lt>233>") to the corresponding
-unaccented US-ASCII letters (like a simple character 101, "e"), but
-clearly this is often not feasible, and an unrenderable character may
-be represented as "?", or the like. In attempting a sane fallback
-(as from EE<lt>233> to "e"), Pod formatters may use the
-%Latin1Code_to_fallback table in L<Pod::Escapes|Pod::Escapes>, or
-L<Text::Unidecode|Text::Unidecode>, if available.
-
-For example, this Pod text:
-
- magic is enabled if you set C<$Currency> to 'E<euro>'.
-
-may be rendered as:
-"magic is enabled if you set C<$Currency> to 'I<?>'" or as
-"magic is enabled if you set C<$Currency> to 'B<[euro]>'", or as
-"magic is enabled if you set C<$Currency> to '[x20AC]', etc.
-
-A Pod formatter may also note, in a comment or warning, a list of what
-unrenderable characters were encountered.
-
-=item *
-
-EE<lt>...> may freely appear in any formatting code (other than
-in another EE<lt>...> or in an ZE<lt>>). That is, "XE<lt>The
-EE<lt>euro>1,000,000 Solution>" is valid, as is "LE<lt>The
-EE<lt>euro>1,000,000 Solution|Million::Euros>".
-
-=item *
-
-Some Pod formatters output to formats that implement nonbreaking
-spaces as an individual character (which I'll call "NBSP"), and
-others output to formats that implement nonbreaking spaces just as
-spaces wrapped in a "don't break this across lines" code. Note that
-at the level of Pod, both sorts of codes can occur: Pod can contain a
-NBSP character (whether as a literal, or as a "EE<lt>160>" or
-"EE<lt>nbsp>" code); and Pod can contain "SE<lt>foo
-IE<lt>barE<gt> baz>" codes, where "mere spaces" (character 32) in
-such codes are taken to represent nonbreaking spaces. Pod
-parsers should consider supporting the optional parsing of "SE<lt>foo
-IE<lt>barE<gt> baz>" as if it were
-"fooI<NBSP>IE<lt>barE<gt>I<NBSP>baz", and, going the other way, the
-optional parsing of groups of words joined by NBSP's as if each group
-were in a SE<lt>...> code, so that formatters may use the
-representation that maps best to what the output format demands.
-
-=item *
-
-Some processors may find that the C<SE<lt>...E<gt>> code is easiest to
-implement by replacing each space in the parse tree under the content
-of the S, with an NBSP. But note: the replacement should apply I<not> to
-spaces in I<all> text, but I<only> to spaces in I<printable> text. (This
-distinction may or may not be evident in the particular tree/event
-model implemented by the Pod parser.) For example, consider this
-unusual case:
-
- S<L</Autoloaded Functions>>
-
-This means that the space in the middle of the visible link text must
-not be broken across lines. In other words, it's the same as this:
-
- L<"AutoloadedE<160>Functions"/Autoloaded Functions>
-
-However, a misapplied space-to-NBSP replacement could (wrongly)
-produce something equivalent to this:
-
- L<"AutoloadedE<160>Functions"/AutoloadedE<160>Functions>
-
-...which is almost definitely not going to work as a hyperlink (assuming
-this formatter outputs a format supporting hypertext).
-
-Formatters may choose to just not support the S format code,
-especially in cases where the output format simply has no NBSP
-character/code and no code for "don't break this stuff across lines".
-
-=item *
-
-Besides the NBSP character discussed above, implementors are reminded
-of the existence of the other "special" character in Latin-1, the
-"soft hyphen" character, also known as "discretionary hyphen",
-i.e. C<EE<lt>173E<gt>> = C<EE<lt>0xADE<gt>> =
-C<EE<lt>shyE<gt>>). This character expresses an optional hyphenation
-point. That is, it normally renders as nothing, but may render as a
-"-" if a formatter breaks the word at that point. Pod formatters
-should, as appropriate, do one of the following: 1) render this with
-a code with the same meaning (e.g., "\-" in RTF), 2) pass it through
-in the expectation that the formatter understands this character as
-such, or 3) delete it.
-
-For example:
-
- sigE<shy>action
- manuE<shy>script
- JarkE<shy>ko HieE<shy>taE<shy>nieE<shy>mi
-
-These signal to a formatter that if it is to hyphenate "sigaction"
-or "manuscript", then it should be done as
-"sig-I<[linebreak]>action" or "manu-I<[linebreak]>script"
-(and if it doesn't hyphenate it, then the C<EE<lt>shyE<gt>> doesn't
-show up at all). And if it is
-to hyphenate "Jarkko" and/or "Hietaniemi", it can do
-so only at the points where there is a C<EE<lt>shyE<gt>> code.
-
-In practice, it is anticipated that this character will not be used
-often, but formatters should either support it, or delete it.
-
-=item *
-
-If you think that you want to add a new command to Pod (like, say, a
-"=biblio" command), consider whether you could get the same
-effect with a for or begin/end sequence: "=for biblio ..." or "=begin
-biblio" ... "=end biblio". Pod processors that don't understand
-"=for biblio", etc, will simply ignore it, whereas they may complain
-loudly if they see "=biblio".
-
-=item *
-
-Throughout this document, "Pod" has been the preferred spelling for
-the name of the documentation format. One may also use "POD" or
-"pod". For the documentation that is (typically) in the Pod
-format, you may use "pod", or "Pod", or "POD". Understanding these
-distinctions is useful; but obsessing over how to spell them, usually
-is not.
-
-=back
-
-
-
-
-
-=head1 About LE<lt>...E<gt> Codes
-
-As you can tell from a glance at L<perlpod|perlpod>, the LE<lt>...>
-code is the most complex of the Pod formatting codes. The points below
-will hopefully clarify what it means and how processors should deal
-with it.
-
-=over
-
-=item *
-
-In parsing an LE<lt>...> code, Pod parsers must distinguish at least
-four attributes:
-
-=over
-
-=item First:
-
-The link-text. If there is none, this must be undef. (E.g., in
-"LE<lt>Perl Functions|perlfunc>", the link-text is "Perl Functions".
-In "LE<lt>Time::HiRes>" and even "LE<lt>|Time::HiRes>", there is no
-link text. Note that link text may contain formatting.)
-
-=item Second:
-
-The possibly inferred link-text -- i.e., if there was no real link
-text, then this is the text that we'll infer in its place. (E.g., for
-"LE<lt>Getopt::Std>", the inferred link text is "Getopt::Std".)
-
-=item Third:
-
-The name or URL, or undef if none. (E.g., in "LE<lt>Perl
-Functions|perlfunc>", the name -- also sometimes called the page --
-is "perlfunc". In "LE<lt>/CAVEATS>", the name is undef.)
-
-=item Fourth:
-
-The section (AKA "item" in older perlpods), or undef if none. E.g.,
-in L<Getopt::Std/DESCRIPTION>, "DESCRIPTION" is the section. (Note
-that this is not the same as a manpage section like the "5" in "man 5
-crontab". "Section Foo" in the Pod sense means the part of the text
-that's introduced by the heading or item whose text is "Foo".)
-
-=back
-
-Pod parsers may also note additional attributes including:
-
-=over
-
-=item Fifth:
-
-A flag for whether item 3 (if present) is a URL (like
-"http://lists.perl.org" is), in which case there should be no section
-attribute; a Pod name (like "perldoc" and "Getopt::Std" are); or
-possibly a man page name (like "crontab(5)" is).
-
-=item Sixth:
-
-The raw original LE<lt>...> content, before text is split on
-"|", "/", etc, and before EE<lt>...> codes are expanded.
-
-=back
-
-(The above were numbered only for concise reference below. It is not
-a requirement that these be passed as an actual list or array.)
-
-For example:
-
- L<Foo::Bar>
- => undef, # link text
- "Foo::Bar", # possibly inferred link text
- "Foo::Bar", # name
- undef, # section
- 'pod', # what sort of link
- "Foo::Bar" # original content
-
- L<Perlport's section on NL's|perlport/Newlines>
- => "Perlport's section on NL's", # link text
- "Perlport's section on NL's", # possibly inferred link text
- "perlport", # name
- "Newlines", # section
- 'pod', # what sort of link
- "Perlport's section on NL's|perlport/Newlines" # orig. content
-
- L<perlport/Newlines>
- => undef, # link text
- '"Newlines" in perlport', # possibly inferred link text
- "perlport", # name
- "Newlines", # section
- 'pod', # what sort of link
- "perlport/Newlines" # original content
-
- L<crontab(5)/"DESCRIPTION">
- => undef, # link text
- '"DESCRIPTION" in crontab(5)', # possibly inferred link text
- "crontab(5)", # name
- "DESCRIPTION", # section
- 'man', # what sort of link
- 'crontab(5)/"DESCRIPTION"' # original content
-
- L</Object Attributes>
- => undef, # link text
- '"Object Attributes"', # possibly inferred link text
- undef, # name
- "Object Attributes", # section
- 'pod', # what sort of link
- "/Object Attributes" # original content
-
- L<http://www.perl.org/>
- => undef, # link text
- "http://www.perl.org/", # possibly inferred link text
- "http://www.perl.org/", # name
- undef, # section
- 'url', # what sort of link
- "http://www.perl.org/" # original content
-
-Note that you can distinguish URL-links from anything else by the
-fact that they match C<m/\A\w+:[^:\s]\S*\z/>. So
-C<LE<lt>http://www.perl.comE<gt>> is a URL, but
-C<LE<lt>HTTP::ResponseE<gt>> isn't.
-
-=item *
-
-In case of LE<lt>...> codes with no "text|" part in them,
-older formatters have exhibited great variation in actually displaying
-the link or cross reference. For example, LE<lt>crontab(5)> would render
-as "the C<crontab(5)> manpage", or "in the C<crontab(5)> manpage"
-or just "C<crontab(5)>".
-
-Pod processors must now treat "text|"-less links as follows:
-
- L<name> => L<name|name>
- L</section> => L<"section"|/section>
- L<name/section> => L<"section" in name|name/section>
-
-=item *
-
-Note that section names might contain markup. I.e., if a section
-starts with:
-
- =head2 About the C<-M> Operator
-
-or with:
-
- =item About the C<-M> Operator
-
-then a link to it would look like this:
-
- L<somedoc/About the C<-M> Operator>
-
-Formatters may choose to ignore the markup for purposes of resolving
-the link and use only the renderable characters in the section name,
-as in:
-
- <h1><a name="About_the_-M_Operator">About the <code>-M</code>
- Operator</h1>
-
- ...
-
- <a href="somedoc#About_the_-M_Operator">About the <code>-M</code>
- Operator" in somedoc</a>
-
-=item *
-
-Previous versions of perlpod distinguished C<LE<lt>name/"section"E<gt>>
-links from C<LE<lt>name/itemE<gt>> links (and their targets). These
-have been merged syntactically and semantically in the current
-specification, and I<section> can refer either to a "=headI<n> Heading
-Content" command or to a "=item Item Content" command. This
-specification does not specify what behavior should be in the case
-of a given document having several things all seeming to produce the
-same I<section> identifier (e.g., in HTML, several things all producing
-the same I<anchorname> in <a name="I<anchorname>">...</a>
-elements). Where Pod processors can control this behavior, they should
-use the first such anchor. That is, C<LE<lt>Foo/BarE<gt>> refers to the
-I<first> "Bar" section in Foo.
-
-But for some processors/formats this cannot be easily controlled; as
-with the HTML example, the behavior of multiple ambiguous
-<a name="I<anchorname>">...</a> is most easily just left up to
-browsers to decide.
-
-=item *
-
-Authors wanting to link to a particular (absolute) URL, must do so
-only with "LE<lt>scheme:...>" codes (like
-LE<lt>http://www.perl.org>), and must not attempt "LE<lt>Some Site
-Name|scheme:...>" codes. This restriction avoids many problems
-in parsing and rendering LE<lt>...> codes.
-
-=item *
-
-In a C<LE<lt>text|...E<gt>> code, text may contain formatting codes
-for formatting or for EE<lt>...> escapes, as in:
-
- L<B<ummE<234>stuff>|...>
-
-For C<LE<lt>...E<gt>> codes without a "name|" part, only
-C<EE<lt>...E<gt>> and C<ZE<lt>E<gt>> codes may occur -- no
-other formatting codes. That is, authors should not use
-"C<LE<lt>BE<lt>Foo::BarE<gt>E<gt>>".
-
-Note, however, that formatting codes and ZE<lt>>'s can occur in any
-and all parts of an LE<lt>...> (i.e., in I<name>, I<section>, I<text>,
-and I<url>).
-
-Authors must not nest LE<lt>...> codes. For example, "LE<lt>The
-LE<lt>Foo::Bar> man page>" should be treated as an error.
-
-=item *
-
-Note that Pod authors may use formatting codes inside the "text"
-part of "LE<lt>text|name>" (and so on for LE<lt>text|/"sec">).
-
-In other words, this is valid:
-
- Go read L<the docs on C<$.>|perlvar/"$.">
-
-Some output formats that do allow rendering "LE<lt>...>" codes as
-hypertext, might not allow the link-text to be formatted; in
-that case, formatters will have to just ignore that formatting.
-
-=item *
-
-At time of writing, C<LE<lt>nameE<gt>> values are of two types:
-either the name of a Pod page like C<LE<lt>Foo::BarE<gt>> (which
-might be a real Perl module or program in an @INC / PATH
-directory, or a .pod file in those places); or the name of a UNIX
-man page, like C<LE<lt>crontab(5)E<gt>>. In theory, C<LE<lt>chmodE<gt>>
-in ambiguous between a Pod page called "chmod", or the Unix man page
-"chmod" (in whatever man-section). However, the presence of a string
-in parens, as in "crontab(5)", is sufficient to signal that what
-is being discussed is not a Pod page, and so is presumably a
-UNIX man page. The distinction is of no importance to many
-Pod processors, but some processors that render to hypertext formats
-may need to distinguish them in order to know how to render a
-given C<LE<lt>fooE<gt>> code.
-
-=item *
-
-Previous versions of perlpod allowed for a C<LE<lt>sectionE<gt>> syntax
-(as in "C<LE<lt>Object AttributesE<gt>>"), which was not easily distinguishable
-from C<LE<lt>nameE<gt>> syntax. This syntax is no longer in the
-specification, and has been replaced by the C<LE<lt>"section"E<gt>> syntax
-(where the quotes were formerly optional). Pod parsers should tolerate
-the C<LE<lt>sectionE<gt>> syntax, for a while at least. The suggested
-heuristic for distinguishing C<LE<lt>sectionE<gt>> from C<LE<lt>nameE<gt>>
-is that if it contains any whitespace, it's a I<section>. Pod processors
-may warn about this being deprecated syntax.
-
-=back
-
-=head1 About =over...=back Regions
-
-"=over"..."=back" regions are used for various kinds of list-like
-structures. (I use the term "region" here simply as a collective
-term for everything from the "=over" to the matching "=back".)
-
-=over
-
-=item *
-
-The non-zero numeric I<indentlevel> in "=over I<indentlevel>" ...
-"=back" is used for giving the formatter a clue as to how many
-"spaces" (ems, or roughly equivalent units) it should tab over,
-although many formatters will have to convert this to an absolute
-measurement that may not exactly match with the size of spaces (or M's)
-in the document's base font. Other formatters may have to completely
-ignore the number. The lack of any explicit I<indentlevel> parameter is
-equivalent to an I<indentlevel> value of 4. Pod processors may
-complain if I<indentlevel> is present but is not a positive number
-matching C<m/\A(\d*\.)?\d+\z/>.
-
-=item *
-
-Authors of Pod formatters are reminded that "=over" ... "=back" may
-map to several different constructs in your output format. For
-example, in converting Pod to (X)HTML, it can map to any of
-<ul>...</ul>, <ol>...</ol>, <dl>...</dl>, or
-<blockquote>...</blockquote>. Similarly, "=item" can map to <li> or
-<dt>.
-
-=item *
-
-Each "=over" ... "=back" region should be one of the following:
-
-=over
-
-=item *
-
-An "=over" ... "=back" region containing only "=item *" commands,
-each followed by some number of ordinary/verbatim paragraphs, other
-nested "=over" ... "=back" regions, "=for..." paragraphs, and
-"=begin"..."=end" regions.
-
-(Pod processors must tolerate a bare "=item" as if it were "=item
-*".) Whether "*" is rendered as a literal asterisk, an "o", or as
-some kind of real bullet character, is left up to the Pod formatter,
-and may depend on the level of nesting.
-
-=item *
-
-An "=over" ... "=back" region containing only
-C<m/\A=item\s+\d+\.?\s*\z/> paragraphs, each one (or each group of them)
-followed by some number of ordinary/verbatim paragraphs, other nested
-"=over" ... "=back" regions, "=for..." paragraphs, and/or
-"=begin"..."=end" codes. Note that the numbers must start at 1
-in each section, and must proceed in order and without skipping
-numbers.
-
-(Pod processors must tolerate lines like "=item 1" as if they were
-"=item 1.", with the period.)
-
-=item *
-
-An "=over" ... "=back" region containing only "=item [text]"
-commands, each one (or each group of them) followed by some number of
-ordinary/verbatim paragraphs, other nested "=over" ... "=back"
-regions, or "=for..." paragraphs, and "=begin"..."=end" regions.
-
-The "=item [text]" paragraph should not match
-C<m/\A=item\s+\d+\.?\s*\z/> or C<m/\A=item\s+\*\s*\z/>, nor should it
-match just C<m/\A=item\s*\z/>.
-
-=item *
-
-An "=over" ... "=back" region containing no "=item" paragraphs at
-all, and containing only some number of
-ordinary/verbatim paragraphs, and possibly also some nested "=over"
-... "=back" regions, "=for..." paragraphs, and "=begin"..."=end"
-regions. Such an itemless "=over" ... "=back" region in Pod is
-equivalent in meaning to a "<blockquote>...</blockquote>" element in
-HTML.
-
-=back
-
-Note that with all the above cases, you can determine which type of
-"=over" ... "=back" you have, by examining the first (non-"=cut",
-non-"=pod") Pod paragraph after the "=over" command.
-
-=item *
-
-Pod formatters I<must> tolerate arbitrarily large amounts of text
-in the "=item I<text...>" paragraph. In practice, most such
-paragraphs are short, as in:
-
- =item For cutting off our trade with all parts of the world
-
-But they may be arbitrarily long:
-
- =item For transporting us beyond seas to be tried for pretended
- offenses
-
- =item He is at this time transporting large armies of foreign
- mercenaries to complete the works of death, desolation and
- tyranny, already begun with circumstances of cruelty and perfidy
- scarcely paralleled in the most barbarous ages, and totally
- unworthy the head of a civilized nation.
-
-=item *
-
-Pod processors should tolerate "=item *" / "=item I<number>" commands
-with no accompanying paragraph. The middle item is an example:
-
- =over
-
- =item 1
-
- Pick up dry cleaning.
-
- =item 2
-
- =item 3
-
- Stop by the store. Get Abba Zabas, Stoli, and cheap lawn chairs.
-
- =back
-
-=item *
-
-No "=over" ... "=back" region can contain headings. Processors may
-treat such a heading as an error.
-
-=item *
-
-Note that an "=over" ... "=back" region should have some
-content. That is, authors should not have an empty region like this:
-
- =over
-
- =back
-
-Pod processors seeing such a contentless "=over" ... "=back" region,
-may ignore it, or may report it as an error.
-
-=item *
-
-Processors must tolerate an "=over" list that goes off the end of the
-document (i.e., which has no matching "=back"), but they may warn
-about such a list.
-
-=item *
-
-Authors of Pod formatters should note that this construct:
-
- =item Neque
-
- =item Porro
-
- =item Quisquam Est
-
- Qui dolorem ipsum quia dolor sit amet, consectetur, adipisci
- velit, sed quia non numquam eius modi tempora incidunt ut
- labore et dolore magnam aliquam quaerat voluptatem.
-
- =item Ut Enim
-
-is semantically ambiguous, in a way that makes formatting decisions
-a bit difficult. On the one hand, it could be mention of an item
-"Neque", mention of another item "Porro", and mention of another
-item "Quisquam Est", with just the last one requiring the explanatory
-paragraph "Qui dolorem ipsum quia dolor..."; and then an item
-"Ut Enim". In that case, you'd want to format it like so:
-
- Neque
-
- Porro
-
- Quisquam Est
- Qui dolorem ipsum quia dolor sit amet, consectetur, adipisci
- velit, sed quia non numquam eius modi tempora incidunt ut
- labore et dolore magnam aliquam quaerat voluptatem.
-
- Ut Enim
-
-But it could equally well be a discussion of three (related or equivalent)
-items, "Neque", "Porro", and "Quisquam Est", followed by a paragraph
-explaining them all, and then a new item "Ut Enim". In that case, you'd
-probably want to format it like so:
-
- Neque
- Porro
- Quisquam Est
- Qui dolorem ipsum quia dolor sit amet, consectetur, adipisci
- velit, sed quia non numquam eius modi tempora incidunt ut
- labore et dolore magnam aliquam quaerat voluptatem.
-
- Ut Enim
-
-But (for the forseeable future), Pod does not provide any way for Pod
-authors to distinguish which grouping is meant by the above
-"=item"-cluster structure. So formatters should format it like so:
-
- Neque
-
- Porro
-
- Quisquam Est
-
- Qui dolorem ipsum quia dolor sit amet, consectetur, adipisci
- velit, sed quia non numquam eius modi tempora incidunt ut
- labore et dolore magnam aliquam quaerat voluptatem.
-
- Ut Enim
-
-That is, there should be (at least roughly) equal spacing between
-items as between paragraphs (although that spacing may well be less
-than the full height of a line of text). This leaves it to the reader
-to use (con)textual cues to figure out whether the "Qui dolorem
-ipsum..." paragraph applies to the "Quisquam Est" item or to all three
-items "Neque", "Porro", and "Quisquam Est". While not an ideal
-situation, this is preferable to providing formatting cues that may
-be actually contrary to the author's intent.
-
-=back
-
-
-
-=head1 About Data Paragraphs and "=begin/=end" Regions
-
-Data paragraphs are typically used for inlining non-Pod data that is
-to be used (typically passed through) when rendering the document to
-a specific format:
-
- =begin rtf
-
- \par{\pard\qr\sa4500{\i Printed\~\chdate\~\chtime}\par}
-
- =end rtf
-
-The exact same effect could, incidentally, be achieved with a single
-"=for" paragraph:
-
- =for rtf \par{\pard\qr\sa4500{\i Printed\~\chdate\~\chtime}\par}
-
-(Although that is not formally a data paragraph, it has the same
-meaning as one, and Pod parsers may parse it as one.)
-
-Another example of a data paragraph:
-
- =begin html
-
- I like <em>PIE</em>!
-
- <hr>Especially pecan pie!
-
- =end html
-
-If these were ordinary paragraphs, the Pod parser would try to
-expand the "EE<lt>/em>" (in the first paragraph) as a formatting
-code, just like "EE<lt>lt>" or "EE<lt>eacute>". But since this
-is in a "=begin I<identifier>"..."=end I<identifier>" region I<and>
-the identifier "html" doesn't begin have a ":" prefix, the contents
-of this region are stored as data paragraphs, instead of being
-processed as ordinary paragraphs (or if they began with a spaces
-and/or tabs, as verbatim paragraphs).
-
-As a further example: At time of writing, no "biblio" identifier is
-supported, but suppose some processor were written to recognize it as
-a way of (say) denoting a bibliographic reference (necessarily
-containing formatting codes in ordinary paragraphs). The fact that
-"biblio" paragraphs were meant for ordinary processing would be
-indicated by prefacing each "biblio" identifier with a colon:
-
- =begin :biblio
-
- Wirth, Niklaus. 1976. I<Algorithms + Data Structures =
- Programs.> Prentice-Hall, Englewood Cliffs, NJ.
-
- =end :biblio
-
-This would signal to the parser that paragraphs in this begin...end
-region are subject to normal handling as ordinary/verbatim paragraphs
-(while still tagged as meant only for processors that understand the
-"biblio" identifier). The same effect could be had with:
-
- =for :biblio
- Wirth, Niklaus. 1976. I<Algorithms + Data Structures =
- Programs.> Prentice-Hall, Englewood Cliffs, NJ.
-
-The ":" on these identifiers means simply "process this stuff
-normally, even though the result will be for some special target".
-I suggest that parser APIs report "biblio" as the target identifier,
-but also report that it had a ":" prefix. (And similarly, with the
-above "html", report "html" as the target identifier, and note the
-I<lack> of a ":" prefix.)
-
-Note that a "=begin I<identifier>"..."=end I<identifier>" region where
-I<identifier> begins with a colon, I<can> contain commands. For example:
-
- =begin :biblio
-
- Wirth's classic is available in several editions, including:
-
- =for comment
- hm, check abebooks.com for how much used copies cost.
-
- =over
-
- =item
-
- Wirth, Niklaus. 1975. I<Algorithmen und Datenstrukturen.>
- Teubner, Stuttgart. [Yes, it's in German.]
-
- =item
-
- Wirth, Niklaus. 1976. I<Algorithms + Data Structures =
- Programs.> Prentice-Hall, Englewood Cliffs, NJ.
-
- =back
-
- =end :biblio
-
-Note, however, a "=begin I<identifier>"..."=end I<identifier>"
-region where I<identifier> does I<not> begin with a colon, should not
-directly contain "=head1" ... "=head4" commands, nor "=over", nor "=back",
-nor "=item". For example, this may be considered invalid:
-
- =begin somedata
-
- This is a data paragraph.
-
- =head1 Don't do this!
-
- This is a data paragraph too.
-
- =end somedata
-
-A Pod processor may signal that the above (specifically the "=head1"
-paragraph) is an error. Note, however, that the following should
-I<not> be treated as an error:
-
- =begin somedata
-
- This is a data paragraph.
-
- =cut
-
- # Yup, this isn't Pod anymore.
- sub excl { (rand() > .5) ? "hoo!" : "hah!" }
-
- =pod
-
- This is a data paragraph too.
-
- =end somedata
-
-And this too is valid:
-
- =begin someformat
-
- This is a data paragraph.
-
- And this is a data paragraph.
-
- =begin someotherformat
-
- This is a data paragraph too.
-
- And this is a data paragraph too.
-
- =begin :yetanotherformat
-
- =head2 This is a command paragraph!
-
- This is an ordinary paragraph!
-
- And this is a verbatim paragraph!
-
- =end :yetanotherformat
-
- =end someotherformat
-
- Another data paragraph!
-
- =end someformat
-
-The contents of the above "=begin :yetanotherformat" ...
-"=end :yetanotherformat" region I<aren't> data paragraphs, because
-the immediately containing region's identifier (":yetanotherformat")
-begins with a colon. In practice, most regions that contain
-data paragraphs will contain I<only> data paragraphs; however,
-the above nesting is syntactically valid as Pod, even if it is
-rare. However, the handlers for some formats, like "html",
-will accept only data paragraphs, not nested regions; and they may
-complain if they see (targeted for them) nested regions, or commands,
-other than "=end", "=pod", and "=cut".
-
-Also consider this valid structure:
-
- =begin :biblio
-
- Wirth's classic is available in several editions, including:
-
- =over
-
- =item
-
- Wirth, Niklaus. 1975. I<Algorithmen und Datenstrukturen.>
- Teubner, Stuttgart. [Yes, it's in German.]
-
- =item
-
- Wirth, Niklaus. 1976. I<Algorithms + Data Structures =
- Programs.> Prentice-Hall, Englewood Cliffs, NJ.
-
- =back
-
- Buy buy buy!
-
- =begin html
-
- <img src='wirth_spokesmodeling_book.png'>
-
- <hr>
-
- =end html
-
- Now now now!
-
- =end :biblio
-
-There, the "=begin html"..."=end html" region is nested inside
-the larger "=begin :biblio"..."=end :biblio" region. Note that the
-content of the "=begin html"..."=end html" region is data
-paragraph(s), because the immediately containing region's identifier
-("html") I<doesn't> begin with a colon.
-
-Pod parsers, when processing a series of data paragraphs one
-after another (within a single region), should consider them to
-be one large data paragraph that happens to contain blank lines. So
-the content of the above "=begin html"..."=end html" I<may> be stored
-as two data paragraphs (one consisting of
-"<img src='wirth_spokesmodeling_book.png'>\n"
-and another consisting of "<hr>\n"), but I<should> be stored as
-a single data paragraph (consisting of
-"<img src='wirth_spokesmodeling_book.png'>\n\n<hr>\n").
-
-Pod processors should tolerate empty
-"=begin I<something>"..."=end I<something>" regions,
-empty "=begin :I<something>"..."=end :I<something>" regions, and
-contentless "=for I<something>" and "=for :I<something>"
-paragraphs. I.e., these should be tolerated:
-
- =for html
-
- =begin html
-
- =end html
-
- =begin :biblio
-
- =end :biblio
-
-Incidentally, note that there's no easy way to express a data
-paragraph starting with something that looks like a command. Consider:
-
- =begin stuff
-
- =shazbot
-
- =end stuff
-
-There, "=shazbot" will be parsed as a Pod command "shazbot", not as a data
-paragraph "=shazbot\n". However, you can express a data paragraph consisting
-of "=shazbot\n" using this code:
-
- =for stuff =shazbot
-
-The situation where this is necessary, is presumably quite rare.
-
-Note that =end commands must match the currently open =begin command. That
-is, they must properly nest. For example, this is valid:
-
- =begin outer
-
- X
-
- =begin inner
-
- Y
-
- =end inner
-
- Z
-
- =end outer
-
-while this is invalid:
-
- =begin outer
-
- X
-
- =begin inner
-
- Y
-
- =end outer
-
- Z
-
- =end inner
-
-This latter is improper because when the "=end outer" command is seen, the
-currently open region has the formatname "inner", not "outer". (It just
-happens that "outer" is the format name of a higher-up region.) This is
-an error. Processors must by default report this as an error, and may halt
-processing the document containing that error. A corollary of this is that
-regions cannot "overlap" -- i.e., the latter block above does not represent
-a region called "outer" which contains X and Y, overlapping a region called
-"inner" which contains Y and Z. But because it is invalid (as all
-apparently overlapping regions would be), it doesn't represent that, or
-anything at all.
-
-Similarly, this is invalid:
-
- =begin thing
-
- =end hting
-
-This is an error because the region is opened by "thing", and the "=end"
-tries to close "hting" [sic].
-
-This is also invalid:
-
- =begin thing
-
- =end
-
-This is invalid because every "=end" command must have a formatname
-parameter.
-
-=head1 SEE ALSO
-
-L<perlpod>, L<perlsyn/"PODs: Embedded Documentation">,
-L<podchecker>
-
-=head1 AUTHOR
-
-Sean M. Burke
-
-=cut
-
-