From 19d9fee941a2008999cb79ae07b9cfc706d1d6be Mon Sep 17 00:00:00 2001 From: DongHun Kwak Date: Thu, 21 Jul 2022 11:28:23 +0900 Subject: [PATCH] Imported Upstream version 6.27 --- Changes | 17 ++ MANIFEST | 3 +- META.json | 149 ++++++------ META.yml | 136 ++++++----- Makefile.PL | 2 +- bin/lwp-download | 378 ++++++++++++++++--------------- bin/lwp-dump | 22 +- bin/lwp-mirror | 54 ++--- bin/lwp-request | 324 +++++++++++++------------- dist.ini | 3 +- lib/LWP.pm | 2 +- lib/LWP/Authen/Basic.pm | 2 +- lib/LWP/Authen/Digest.pm | 2 +- lib/LWP/Authen/Ntlm.pm | 2 +- lib/LWP/ConnCache.pm | 2 +- lib/LWP/Debug.pm | 2 +- lib/LWP/Debug/TraceHTTP.pm | 7 +- lib/LWP/DebugFile.pm | 2 +- lib/LWP/MemberMixin.pm | 2 +- lib/LWP/Protocol.pm | 2 +- lib/LWP/Protocol/cpan.pm | 2 +- lib/LWP/Protocol/data.pm | 2 +- lib/LWP/Protocol/file.pm | 2 +- lib/LWP/Protocol/ftp.pm | 4 +- lib/LWP/Protocol/gopher.pm | 2 +- lib/LWP/Protocol/http.pm | 12 +- lib/LWP/Protocol/loopback.pm | 2 +- lib/LWP/Protocol/mailto.pm | 2 +- lib/LWP/Protocol/nntp.pm | 2 +- lib/LWP/Protocol/nogo.pm | 2 +- lib/LWP/RobotUA.pm | 2 +- lib/LWP/Simple.pm | 2 +- lib/LWP/UserAgent.pm | 15 +- lwpcook.pod | 12 +- t/10-attrs.t | 47 ++++ t/local/get.t | 9 +- xt/author/eol.t | 1 + xt/author/pod-coverage.t | 18 +- xt/author/pod-spell.t | 11 + xt/release/changes_has_content.t | 2 +- 40 files changed, 677 insertions(+), 587 deletions(-) create mode 100644 t/10-attrs.t diff --git a/Changes b/Changes index 1e3b2c4..58e77fd 100644 --- a/Changes +++ b/Changes @@ -1,5 +1,22 @@ Change history for libwww-perl +6.27 2017-09-21 + - Switch to Getopt::Long in lwp-download (GH #262) + - Fix lwp-request -C (GH #261) + - Hide LWP::Protocol::http::Socket, LWP::Protocol::http::SocketMethods and + LWP::Debug::TraceHTTP::Socket from PAUSE + - Add tests for the "get" & "head" functions (GH #252) + - Update lwpcook.pod (GH #256) + - Handle undefined values in ->credentials (GH #157) + - Fix lwp-mirror options checks. + - Update bin/ scripts to use $LWP::VERSION instead of ->Version() + - Improve lwp-download --help (GH #262) + +6.26 2017-04-12 + - Perltidy all apps in the bin/ directory + - Make all apps in bin/ use strict and warnings (RT #92633) + - Fix bug tracker URL in metadata + 6.25 2017-04-03 - Fix LWP::UserAgent docs for request and request_simple that pointed to functions in LWP::Simple rather than LWP::UserAgent diff --git a/MANIFEST b/MANIFEST index a036ddc..37f2652 100644 --- a/MANIFEST +++ b/MANIFEST @@ -1,4 +1,4 @@ -# This file was automatically generated by Dist::Zilla::Plugin::Manifest v6.008. +# This file was automatically generated by Dist::Zilla::Plugin::Manifest v6.009. CONTRIBUTING.md Changes LICENSE @@ -40,6 +40,7 @@ lwpcook.pod lwptut.pod t/00-report-prereqs.dd t/00-report-prereqs.t +t/10-attrs.t t/base/default_content_type.t t/base/protocols.t t/base/protocols/nntp.t diff --git a/META.json b/META.json index c33f1d3..f82d0cb 100644 --- a/META.json +++ b/META.json @@ -4,7 +4,7 @@ "Gisle Aas " ], "dynamic_config" : 0, - "generated_by" : "Dist::Zilla version 6.008, CPAN::Meta::Converter version 2.150005", + "generated_by" : "Dist::Zilla version 6.009, CPAN::Meta::Converter version 2.150010", "license" : [ "perl_5" ], @@ -108,115 +108,106 @@ "provides" : { "LWP" : { "file" : "lib/LWP.pm", - "version" : "6.25" + "version" : "6.27" }, "LWP::Authen::Basic" : { "file" : "lib/LWP/Authen/Basic.pm", - "version" : "6.25" + "version" : "6.27" }, "LWP::Authen::Digest" : { "file" : "lib/LWP/Authen/Digest.pm", - "version" : "6.25" + "version" : "6.27" }, "LWP::Authen::Ntlm" : { "file" : "lib/LWP/Authen/Ntlm.pm", - "version" : "6.25" + "version" : "6.27" }, "LWP::ConnCache" : { "file" : "lib/LWP/ConnCache.pm", - "version" : "6.25" + "version" : "6.27" }, "LWP::Debug" : { "file" : "lib/LWP/Debug.pm", - "version" : "6.25" + "version" : "6.27" }, "LWP::Debug::TraceHTTP" : { "file" : "lib/LWP/Debug/TraceHTTP.pm", - "version" : "6.25" - }, - "LWP::Debug::TraceHTTP::Socket" : { - "file" : "lib/LWP/Debug/TraceHTTP.pm", - "version" : "6.25" + "version" : "6.27" }, "LWP::DebugFile" : { "file" : "lib/LWP/DebugFile.pm", - "version" : "6.25" + "version" : "6.27" }, "LWP::MemberMixin" : { "file" : "lib/LWP/MemberMixin.pm", - "version" : "6.25" + "version" : "6.27" }, "LWP::Protocol" : { "file" : "lib/LWP/Protocol.pm", - "version" : "6.25" + "version" : "6.27" }, "LWP::Protocol::MyFTP" : { "file" : "lib/LWP/Protocol/ftp.pm", - "version" : "6.25" + "version" : "6.27" }, "LWP::Protocol::cpan" : { "file" : "lib/LWP/Protocol/cpan.pm", - "version" : "6.25" + "version" : "6.27" }, "LWP::Protocol::data" : { "file" : "lib/LWP/Protocol/data.pm", - "version" : "6.25" + "version" : "6.27" }, "LWP::Protocol::file" : { "file" : "lib/LWP/Protocol/file.pm", - "version" : "6.25" + "version" : "6.27" }, "LWP::Protocol::ftp" : { "file" : "lib/LWP/Protocol/ftp.pm", - "version" : "6.25" + "version" : "6.27" }, "LWP::Protocol::gopher" : { "file" : "lib/LWP/Protocol/gopher.pm", - "version" : "6.25" + "version" : "6.27" }, "LWP::Protocol::http" : { "file" : "lib/LWP/Protocol/http.pm", - "version" : "6.25" - }, - "LWP::Protocol::http::Socket" : { - "file" : "lib/LWP/Protocol/http.pm", - "version" : "6.25" - }, - "LWP::Protocol::http::SocketMethods" : { - "file" : "lib/LWP/Protocol/http.pm", - "version" : "6.25" + "version" : "6.27" }, "LWP::Protocol::loopback" : { "file" : "lib/LWP/Protocol/loopback.pm", - "version" : "6.25" + "version" : "6.27" }, "LWP::Protocol::mailto" : { "file" : "lib/LWP/Protocol/mailto.pm", - "version" : "6.25" + "version" : "6.27" }, "LWP::Protocol::nntp" : { "file" : "lib/LWP/Protocol/nntp.pm", - "version" : "6.25" + "version" : "6.27" }, "LWP::Protocol::nogo" : { "file" : "lib/LWP/Protocol/nogo.pm", - "version" : "6.25" + "version" : "6.27" }, "LWP::RobotUA" : { "file" : "lib/LWP/RobotUA.pm", - "version" : "6.25" + "version" : "6.27" }, "LWP::Simple" : { "file" : "lib/LWP/Simple.pm", - "version" : "6.25" + "version" : "6.27" }, "LWP::UserAgent" : { "file" : "lib/LWP/UserAgent.pm", - "version" : "6.25" + "version" : "6.27" } }, "release_status" : "stable", "resources" : { + "bugtracker" : { + "web" : "https://github.com/libwww-perl/libwww-perl/issues" + }, "homepage" : "https://github.com/libwww-perl/libwww-perl", "repository" : { "type" : "git", @@ -226,7 +217,7 @@ "x_IRC" : "irc://irc.perl.org/#lwp", "x_MailingList" : "mailto:libwww@perl.org" }, - "version" : "6.25", + "version" : "6.27", "x_Dist_Zilla" : { "perl" : { "version" : "5.024000" @@ -259,12 +250,12 @@ { "class" : "Dist::Zilla::Plugin::PruneCruft", "name" : "PruneCruft", - "version" : "6.008" + "version" : "6.009" }, { "class" : "Dist::Zilla::Plugin::MetaConfig", "name" : "MetaConfig", - "version" : "6.008" + "version" : "6.009" }, { "class" : "Dist::Zilla::Plugin::MetaProvides::Package", @@ -274,16 +265,16 @@ { "class" : "Dist::Zilla::Plugin::FinderCode", "name" : "MetaProvides::Package/AUTOVIV/:InstallModulesPM", - "version" : "6.008" + "version" : "6.009" } ], "include_underscores" : 0 }, "Dist::Zilla::Role::MetaProvider::Provider" : { "$Dist::Zilla::Role::MetaProvider::Provider::VERSION" : "2.002003", - "inherit_missing" : "1", - "inherit_version" : "1", - "meta_noindex" : "1" + "inherit_missing" : 1, + "inherit_version" : 1, + "meta_noindex" : 1 }, "Dist::Zilla::Role::ModuleMetadata" : { "Module::Metadata" : "1.000031", @@ -296,22 +287,22 @@ { "class" : "Dist::Zilla::Plugin::MetaNoIndex", "name" : "MetaNoIndex", - "version" : "6.008" + "version" : "6.009" }, { "class" : "Dist::Zilla::Plugin::MetaYAML", "name" : "MetaYAML", - "version" : "6.008" + "version" : "6.009" }, { "class" : "Dist::Zilla::Plugin::MetaJSON", "name" : "MetaJSON", - "version" : "6.008" + "version" : "6.009" }, { "class" : "Dist::Zilla::Plugin::MetaResources", "name" : "MetaResources", - "version" : "6.008" + "version" : "6.009" }, { "class" : "Dist::Zilla::Plugin::Git::Tag", @@ -320,12 +311,12 @@ "branch" : null, "changelog" : "Changes", "signed" : 0, - "tag" : "v6.25", + "tag" : "v6.27", "tag_format" : "v%v", "tag_message" : "v%v" }, "Dist::Zilla::Role::Git::Repo" : { - "git --version" : "2.11.0", + "git --version" : "2.14.1", "repo_root" : "." }, "Dist::Zilla::Role::Git::StringFormatter" : { @@ -345,7 +336,7 @@ "remotes_must_exist" : 1 }, "Dist::Zilla::Role::Git::Repo" : { - "git --version" : "2.11.0", + "git --version" : "2.14.1", "repo_root" : "." } }, @@ -371,7 +362,7 @@ "changelog" : "Changes" }, "Dist::Zilla::Role::Git::Repo" : { - "git --version" : "2.11.0", + "git --version" : "2.14.1", "repo_root" : "." } }, @@ -398,7 +389,7 @@ "changelog" : "Changes" }, "Dist::Zilla::Role::Git::Repo" : { - "git --version" : "2.11.0", + "git --version" : "2.14.1", "repo_root" : "." }, "Dist::Zilla::Role::Git::StringFormatter" : { @@ -412,7 +403,7 @@ "class" : "Dist::Zilla::Plugin::Git::Contributors", "config" : { "Dist::Zilla::Plugin::Git::Contributors" : { - "git --version" : "2.11.0", + "git --version" : "2.14.1", "include_authors" : 0, "include_releaser" : 1, "order_by" : "name", @@ -435,12 +426,12 @@ { "class" : "Dist::Zilla::Plugin::Manifest", "name" : "Manifest", - "version" : "6.008" + "version" : "6.009" }, { "class" : "Dist::Zilla::Plugin::License", "name" : "License", - "version" : "6.008" + "version" : "6.009" }, { "class" : "Dist::Zilla::Plugin::ReadmeAnyFromPod", @@ -455,17 +446,17 @@ { "class" : "Dist::Zilla::Plugin::ExecDir", "name" : "ExecDir", - "version" : "6.008" + "version" : "6.009" }, { "class" : "Dist::Zilla::Plugin::PkgVersion", "name" : "PkgVersion", - "version" : "6.008" + "version" : "6.009" }, { "class" : "Dist::Zilla::Plugin::NextRelease", "name" : "NextRelease", - "version" : "6.008" + "version" : "6.009" }, { "class" : "Dist::Zilla::Plugin::Prereqs::FromCPANfile", @@ -485,17 +476,17 @@ { "class" : "Dist::Zilla::Plugin::TestRelease", "name" : "TestRelease", - "version" : "6.008" + "version" : "6.009" }, { "class" : "Dist::Zilla::Plugin::ConfirmRelease", "name" : "ConfirmRelease", - "version" : "6.008" + "version" : "6.009" }, { "class" : "Dist::Zilla::Plugin::UploadToCPAN", "name" : "UploadToCPAN", - "version" : "6.008" + "version" : "6.009" }, { "class" : "Dist::Zilla::Plugin::CheckChangeLog", @@ -574,7 +565,7 @@ { "class" : "Dist::Zilla::Plugin::MetaTests", "name" : "MetaTests", - "version" : "6.008" + "version" : "6.009" }, { "class" : "Dist::Zilla::Plugin::Test::ChangesHasContent", @@ -589,7 +580,7 @@ { "class" : "Dist::Zilla::Plugin::PodSyntaxTests", "name" : "PodSyntaxTests", - "version" : "6.008" + "version" : "6.009" }, { "class" : "Dist::Zilla::Plugin::Test::Pod::Coverage::Configurable", @@ -751,65 +742,65 @@ { "class" : "Dist::Zilla::Plugin::FinderCode", "name" : ":InstallModules", - "version" : "6.008" + "version" : "6.009" }, { "class" : "Dist::Zilla::Plugin::FinderCode", "name" : ":IncModules", - "version" : "6.008" + "version" : "6.009" }, { "class" : "Dist::Zilla::Plugin::FinderCode", "name" : ":TestFiles", - "version" : "6.008" + "version" : "6.009" }, { "class" : "Dist::Zilla::Plugin::FinderCode", "name" : ":ExtraTestFiles", - "version" : "6.008" + "version" : "6.009" }, { "class" : "Dist::Zilla::Plugin::FinderCode", "name" : ":ExecFiles", - "version" : "6.008" + "version" : "6.009" }, { "class" : "Dist::Zilla::Plugin::FinderCode", "name" : ":PerlExecFiles", - "version" : "6.008" + "version" : "6.009" }, { "class" : "Dist::Zilla::Plugin::FinderCode", "name" : ":ShareFiles", - "version" : "6.008" + "version" : "6.009" }, { "class" : "Dist::Zilla::Plugin::FinderCode", "name" : ":MainModule", - "version" : "6.008" + "version" : "6.009" }, { "class" : "Dist::Zilla::Plugin::FinderCode", "name" : ":AllFiles", - "version" : "6.008" + "version" : "6.009" }, { "class" : "Dist::Zilla::Plugin::FinderCode", "name" : ":NoFiles", - "version" : "6.008" + "version" : "6.009" }, { "class" : "Dist::Zilla::Plugin::FinderCode", "name" : "MetaProvides::Package/AUTOVIV/:InstallModulesPM", - "version" : "6.008" + "version" : "6.009" } ], "zilla" : { "class" : "Dist::Zilla::Dist::Builder", "config" : { - "is_trial" : "0" + "is_trial" : 0 }, - "version" : "6.008" + "version" : "6.009" } }, "x_authority" : "cpan:LWWWP", @@ -830,6 +821,7 @@ "Daniel Hedlund ", "David E. Wheeler ", "DAVIDRW ", + "David Standish ", "David Steinbrunner ", "Father Chrysostomos ", "FWILES ", @@ -843,6 +835,7 @@ "Ian Kilgore ", "Jacob J ", "Jakub Wilk ", + "James Raspass ", "Jason A Fesler ", "jefflee ", "Jeremy Mates ", @@ -852,6 +845,7 @@ "Karen Etheridge ", "Katarina Durechova ", "Mark Stosberg ", + "Martin H. Sluka ", "Matthew Horsfall ", "michael gong ", "Michael G. Schwern ", @@ -878,6 +872,7 @@ "Theodore Robert Campbell Jr ", "Tim Couzins ", "Todd Lipcon ", + "Tomasz Konojacki ", "Tom Hukins ", "Tony Finch ", "Toru Yamaguchi ", diff --git a/META.yml b/META.yml index 0918d79..dc7e870 100644 --- a/META.yml +++ b/META.yml @@ -14,7 +14,7 @@ configure_requires: File::Copy: '0' Getopt::Long: '0' dynamic_config: 0 -generated_by: 'Dist::Zilla version 6.008, CPAN::Meta::Converter version 2.150005' +generated_by: 'Dist::Zilla version 6.009, CPAN::Meta::Converter version 2.150010' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html @@ -27,85 +27,76 @@ no_index: provides: LWP: file: lib/LWP.pm - version: '6.25' + version: '6.27' LWP::Authen::Basic: file: lib/LWP/Authen/Basic.pm - version: '6.25' + version: '6.27' LWP::Authen::Digest: file: lib/LWP/Authen/Digest.pm - version: '6.25' + version: '6.27' LWP::Authen::Ntlm: file: lib/LWP/Authen/Ntlm.pm - version: '6.25' + version: '6.27' LWP::ConnCache: file: lib/LWP/ConnCache.pm - version: '6.25' + version: '6.27' LWP::Debug: file: lib/LWP/Debug.pm - version: '6.25' + version: '6.27' LWP::Debug::TraceHTTP: file: lib/LWP/Debug/TraceHTTP.pm - version: '6.25' - LWP::Debug::TraceHTTP::Socket: - file: lib/LWP/Debug/TraceHTTP.pm - version: '6.25' + version: '6.27' LWP::DebugFile: file: lib/LWP/DebugFile.pm - version: '6.25' + version: '6.27' LWP::MemberMixin: file: lib/LWP/MemberMixin.pm - version: '6.25' + version: '6.27' LWP::Protocol: file: lib/LWP/Protocol.pm - version: '6.25' + version: '6.27' LWP::Protocol::MyFTP: file: lib/LWP/Protocol/ftp.pm - version: '6.25' + version: '6.27' LWP::Protocol::cpan: file: lib/LWP/Protocol/cpan.pm - version: '6.25' + version: '6.27' LWP::Protocol::data: file: lib/LWP/Protocol/data.pm - version: '6.25' + version: '6.27' LWP::Protocol::file: file: lib/LWP/Protocol/file.pm - version: '6.25' + version: '6.27' LWP::Protocol::ftp: file: lib/LWP/Protocol/ftp.pm - version: '6.25' + version: '6.27' LWP::Protocol::gopher: file: lib/LWP/Protocol/gopher.pm - version: '6.25' + version: '6.27' LWP::Protocol::http: file: lib/LWP/Protocol/http.pm - version: '6.25' - LWP::Protocol::http::Socket: - file: lib/LWP/Protocol/http.pm - version: '6.25' - LWP::Protocol::http::SocketMethods: - file: lib/LWP/Protocol/http.pm - version: '6.25' + version: '6.27' LWP::Protocol::loopback: file: lib/LWP/Protocol/loopback.pm - version: '6.25' + version: '6.27' LWP::Protocol::mailto: file: lib/LWP/Protocol/mailto.pm - version: '6.25' + version: '6.27' LWP::Protocol::nntp: file: lib/LWP/Protocol/nntp.pm - version: '6.25' + version: '6.27' LWP::Protocol::nogo: file: lib/LWP/Protocol/nogo.pm - version: '6.25' + version: '6.27' LWP::RobotUA: file: lib/LWP/RobotUA.pm - version: '6.25' + version: '6.27' LWP::Simple: file: lib/LWP/Simple.pm - version: '6.25' + version: '6.27' LWP::UserAgent: file: lib/LWP/UserAgent.pm - version: '6.25' + version: '6.27' requires: Digest::MD5: '0' Encode: '2.12' @@ -139,9 +130,10 @@ requires: resources: IRC: irc://irc.perl.org/#lwp MailingList: mailto:libwww@perl.org + bugtracker: https://github.com/libwww-perl/libwww-perl/issues homepage: https://github.com/libwww-perl/libwww-perl repository: https://github.com/libwww-perl/libwww-perl.git -version: '6.25' +version: '6.27' x_Dist_Zilla: perl: version: '5.024000' @@ -168,11 +160,11 @@ x_Dist_Zilla: - class: Dist::Zilla::Plugin::PruneCruft name: PruneCruft - version: '6.008' + version: '6.009' - class: Dist::Zilla::Plugin::MetaConfig name: MetaConfig - version: '6.008' + version: '6.009' - class: Dist::Zilla::Plugin::MetaProvides::Package config: @@ -181,7 +173,7 @@ x_Dist_Zilla: - class: Dist::Zilla::Plugin::FinderCode name: MetaProvides::Package/AUTOVIV/:InstallModulesPM - version: '6.008' + version: '6.009' include_underscores: 0 Dist::Zilla::Role::MetaProvider::Provider: $Dist::Zilla::Role::MetaProvider::Provider::VERSION: '2.002003' @@ -196,19 +188,19 @@ x_Dist_Zilla: - class: Dist::Zilla::Plugin::MetaNoIndex name: MetaNoIndex - version: '6.008' + version: '6.009' - class: Dist::Zilla::Plugin::MetaYAML name: MetaYAML - version: '6.008' + version: '6.009' - class: Dist::Zilla::Plugin::MetaJSON name: MetaJSON - version: '6.008' + version: '6.009' - class: Dist::Zilla::Plugin::MetaResources name: MetaResources - version: '6.008' + version: '6.009' - class: Dist::Zilla::Plugin::Git::Tag config: @@ -216,11 +208,11 @@ x_Dist_Zilla: branch: ~ changelog: Changes signed: 0 - tag: v6.25 + tag: v6.27 tag_format: v%v tag_message: v%v Dist::Zilla::Role::Git::Repo: - 'git --version': 2.11.0 + 'git --version': 2.14.1 repo_root: . Dist::Zilla::Role::Git::StringFormatter: time_zone: local @@ -234,7 +226,7 @@ x_Dist_Zilla: - origin remotes_must_exist: 1 Dist::Zilla::Role::Git::Repo: - 'git --version': 2.11.0 + 'git --version': 2.14.1 repo_root: . name: '@Filter/Push' version: '2.041' @@ -254,7 +246,7 @@ x_Dist_Zilla: allow_dirty_match: [] changelog: Changes Dist::Zilla::Role::Git::Repo: - 'git --version': 2.11.0 + 'git --version': 2.14.1 repo_root: . name: Git::Check version: '2.041' @@ -275,7 +267,7 @@ x_Dist_Zilla: allow_dirty_match: [] changelog: Changes Dist::Zilla::Role::Git::Repo: - 'git --version': 2.11.0 + 'git --version': 2.14.1 repo_root: . Dist::Zilla::Role::Git::StringFormatter: time_zone: local @@ -285,7 +277,7 @@ x_Dist_Zilla: class: Dist::Zilla::Plugin::Git::Contributors config: Dist::Zilla::Plugin::Git::Contributors: - 'git --version': 2.11.0 + 'git --version': 2.14.1 include_authors: 0 include_releaser: 1 order_by: name @@ -303,11 +295,11 @@ x_Dist_Zilla: - class: Dist::Zilla::Plugin::Manifest name: Manifest - version: '6.008' + version: '6.009' - class: Dist::Zilla::Plugin::License name: License - version: '6.008' + version: '6.009' - class: Dist::Zilla::Plugin::ReadmeAnyFromPod config: @@ -318,15 +310,15 @@ x_Dist_Zilla: - class: Dist::Zilla::Plugin::ExecDir name: ExecDir - version: '6.008' + version: '6.009' - class: Dist::Zilla::Plugin::PkgVersion name: PkgVersion - version: '6.008' + version: '6.009' - class: Dist::Zilla::Plugin::NextRelease name: NextRelease - version: '6.008' + version: '6.009' - class: Dist::Zilla::Plugin::Prereqs::FromCPANfile name: Prereqs::FromCPANfile @@ -341,15 +333,15 @@ x_Dist_Zilla: - class: Dist::Zilla::Plugin::TestRelease name: TestRelease - version: '6.008' + version: '6.009' - class: Dist::Zilla::Plugin::ConfirmRelease name: ConfirmRelease - version: '6.008' + version: '6.009' - class: Dist::Zilla::Plugin::UploadToCPAN name: UploadToCPAN - version: '6.008' + version: '6.009' - class: Dist::Zilla::Plugin::CheckChangeLog name: CheckChangeLog @@ -410,7 +402,7 @@ x_Dist_Zilla: - class: Dist::Zilla::Plugin::MetaTests name: MetaTests - version: '6.008' + version: '6.009' - class: Dist::Zilla::Plugin::Test::ChangesHasContent name: Test::ChangesHasContent @@ -422,7 +414,7 @@ x_Dist_Zilla: - class: Dist::Zilla::Plugin::PodSyntaxTests name: PodSyntaxTests - version: '6.008' + version: '6.009' - class: Dist::Zilla::Plugin::Test::Pod::Coverage::Configurable name: Test::Pod::Coverage::Configurable @@ -572,52 +564,52 @@ x_Dist_Zilla: - class: Dist::Zilla::Plugin::FinderCode name: ':InstallModules' - version: '6.008' + version: '6.009' - class: Dist::Zilla::Plugin::FinderCode name: ':IncModules' - version: '6.008' + version: '6.009' - class: Dist::Zilla::Plugin::FinderCode name: ':TestFiles' - version: '6.008' + version: '6.009' - class: Dist::Zilla::Plugin::FinderCode name: ':ExtraTestFiles' - version: '6.008' + version: '6.009' - class: Dist::Zilla::Plugin::FinderCode name: ':ExecFiles' - version: '6.008' + version: '6.009' - class: Dist::Zilla::Plugin::FinderCode name: ':PerlExecFiles' - version: '6.008' + version: '6.009' - class: Dist::Zilla::Plugin::FinderCode name: ':ShareFiles' - version: '6.008' + version: '6.009' - class: Dist::Zilla::Plugin::FinderCode name: ':MainModule' - version: '6.008' + version: '6.009' - class: Dist::Zilla::Plugin::FinderCode name: ':AllFiles' - version: '6.008' + version: '6.009' - class: Dist::Zilla::Plugin::FinderCode name: ':NoFiles' - version: '6.008' + version: '6.009' - class: Dist::Zilla::Plugin::FinderCode name: MetaProvides::Package/AUTOVIV/:InstallModulesPM - version: '6.008' + version: '6.009' zilla: class: Dist::Zilla::Dist::Builder config: is_trial: '0' - version: '6.008' + version: '6.009' x_authority: cpan:LWWWP x_contributors: - 'Adam Kennedy ' @@ -636,6 +628,7 @@ x_contributors: - 'Daniel Hedlund ' - 'David E. Wheeler ' - 'DAVIDRW ' + - 'David Standish ' - 'David Steinbrunner ' - 'Father Chrysostomos ' - 'FWILES ' @@ -649,6 +642,7 @@ x_contributors: - 'Ian Kilgore ' - 'Jacob J ' - 'Jakub Wilk ' + - 'James Raspass ' - 'Jason A Fesler ' - 'jefflee ' - 'Jeremy Mates ' @@ -658,6 +652,7 @@ x_contributors: - 'Karen Etheridge ' - 'Katarina Durechova ' - 'Mark Stosberg ' + - 'Martin H. Sluka ' - 'Matthew Horsfall ' - 'michael gong ' - 'Michael G. Schwern ' @@ -684,6 +679,7 @@ x_contributors: - 'Theodore Robert Campbell Jr ' - 'Tim Couzins ' - 'Todd Lipcon ' + - 'Tomasz Konojacki ' - 'Tom Hukins ' - 'Tony Finch ' - 'Toru Yamaguchi ' diff --git a/Makefile.PL b/Makefile.PL index 15e73ad..4d793bb 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -83,7 +83,7 @@ my %WriteMakefileArgs = ( "Test::More" => 0, "Test::RequiresInternet" => 0 }, - "VERSION" => "6.25", + "VERSION" => "6.27", "test" => { "TESTS" => "t/*.t t/base/*.t t/base/protocols/*.t t/local/*.t t/robot/*.t" } diff --git a/bin/lwp-download b/bin/lwp-download index 1686bbb..17c2ca1 100755 --- a/bin/lwp-download +++ b/bin/lwp-download @@ -1,4 +1,4 @@ -#!/usr/bin/perl -w +#!/usr/bin/perl =head1 NAME @@ -6,7 +6,12 @@ lwp-download - Fetch large files from the web =head1 SYNOPSIS -B [B<-a>] [B<-s>] > [>] + lwp-download [-a] [-s] [] + + Options: + + -a save the file in ASCII mode + -s use HTTP headers to guess output filename =head1 DESCRIPTION @@ -56,209 +61,217 @@ Gisle Aas #' get emacs out of quote mode use strict; +use warnings; use LWP::UserAgent (); use LWP::MediaTypes qw(guess_media_type media_suffix); -use URI (); +use URI (); use HTTP::Date (); use Encode; use Encode::Locale; +use Getopt::Long qw(HelpMessage :config gnu_getopt no_ignore_case auto_help); my $progname = $0; $progname =~ s,.*/,,; # only basename left in progname $progname =~ s,.*\\,, if $^O eq "MSWin32"; -$progname =~ s/\.\w*$//; # strip extension if any +$progname =~ s/\.\w*$//; # strip extension if any -#parse option -use Getopt::Std; my %opt; -unless (getopts('as', \%opt)) { - usage(); -} +GetOptions( + 'a' => \$opt{a}, + 's' => \$opt{s} +) or HelpMessage(); -my $url = URI->new(decode(locale => shift) || usage()); +my $url = URI->new(decode(locale => shift) || HelpMessage()); my $argfile = encode(locale_fs => decode(locale => shift)); -usage() if defined($argfile) && !length($argfile); +HelpMessage() if defined($argfile) && !length($argfile); my $ua = LWP::UserAgent->new( - agent => "lwp-download/$LWP::UserAgent::VERSION ", - keep_alive => 1, - env_proxy => 1, + agent => "lwp-download/$LWP::UserAgent::VERSION ", + keep_alive => 1, + env_proxy => 1, ); -my $file; # name of file we download into -my $length; # total number of bytes to download -my $flength; # formatted length -my $size = 0; # number of bytes received -my $start_t; # start time of download -my $last_dur; # time of last callback +my $file; # name of file we download into +my $length; # total number of bytes to download +my $flength; # formatted length +my $size = 0; # number of bytes received +my $start_t; # start time of download +my $last_dur; # time of last callback -my $shown = 0; # have we called the show() function yet +my $shown = 0; # have we called the show() function yet $SIG{INT} = sub { die "Interrupted\n"; }; -$| = 1; # autoflush - -my $res = $ua->request(HTTP::Request->new(GET => $url), - sub { - unless(defined $file) { - my $res = $_[1]; - - my $directory; - if (defined $argfile && -d $argfile) { - ($directory, $argfile) = ($argfile, undef); - } - - unless (defined $argfile) { - # find a suitable name to use - $file = $opt{s} && $res->filename; - - # if this fails we try to make something from the URL - unless ($file) { - $file = ($url->path_segments)[-1]; - if (!defined($file) || !length($file)) { - $file = "index"; - my $suffix = media_suffix($res->content_type); - $file .= ".$suffix" if $suffix; - } - elsif ($url->scheme eq 'ftp' || - $file =~ /\.t[bg]z$/ || - $file =~ /\.tar(\.(Z|gz|bz2?))?$/ - ) { - # leave the filename as it was - } - else { - my $ct = guess_media_type($file); - unless ($ct eq $res->content_type) { - # need a better suffix for this type - my $suffix = media_suffix($res->content_type); - $file .= ".$suffix" if $suffix; - } - } - } - - # validate that we don't have a harmful filename now. The server - # might try to trick us into doing something bad. - if (!length($file) || - $file =~ s/([^a-zA-Z0-9_\.\-\+\~])/sprintf "\\x%02x", ord($1)/ge || - $file =~ /^\./ - ) - { - die "Will not save <$url> as \"$file\".\nPlease override file name on the command line.\n"; - } - - if (defined $directory) { - require File::Spec; - $file = File::Spec->catfile($directory, $file); - } - - # Check if the file is already present - if (-l $file) { - die "Will not save <$url> to link \"$file\".\nPlease override file name on the command line.\n"; - } - elsif (-f _) { - die "Will not save <$url> as \"$file\" without verification.\nEither run from terminal or override file name on the command line.\n" - unless -t; - $shown = 1; - print "Overwrite $file? [y] "; - my $ans = ; - unless (defined($ans) && $ans =~ /^y?\n/) { - if (defined $ans) { - print "Ok, aborting.\n"; - } - else { - print "\nAborting.\n"; - } - exit 1; - } - $shown = 0; - } - elsif (-e _) { - die "Will not save <$url> as \"$file\". Path exists.\n"; - } - else { - print "Saving to '$file'...\n"; - use Fcntl qw(O_WRONLY O_EXCL O_CREAT); - sysopen(FILE, $file, O_WRONLY|O_EXCL|O_CREAT) || - die "Can't open $file: $!"; - } - } - else { - $file = $argfile; - } - unless (fileno(FILE)) { - open(FILE, ">", $file) || die "Can't open $file: $!\n"; - } - binmode FILE unless $opt{a}; - $length = $res->content_length; - $flength = fbytes($length) if defined $length; - $start_t = time; - $last_dur = 0; - } - - print FILE $_[0] or die "Can't write to $file: $!\n"; - $size += length($_[0]); - - if (defined $length) { - my $dur = time - $start_t; - if ($dur != $last_dur) { # don't update too often - $last_dur = $dur; - my $perc = $size / $length; - my $speed; - $speed = fbytes($size/$dur) . "/sec" if $dur > 3; - my $secs_left = fduration($dur/$perc - $dur); - $perc = int($perc*100); - my $show = "$perc% of $flength"; - $show .= " (at $speed, $secs_left remaining)" if $speed; - show($show, 1); - } - } - else { - show( fbytes($size) . " received"); - } - } +$| = 1; # autoflush + +my $res = $ua->request( + HTTP::Request->new(GET => $url), + sub { + unless (defined $file) { + my $res = $_[1]; + + my $directory; + if (defined $argfile && -d $argfile) { + ($directory, $argfile) = ($argfile, undef); + } + + unless (defined $argfile) { + + # find a suitable name to use + $file = $opt{s} && $res->filename; + + # if this fails we try to make something from the URL + unless ($file) { + $file = ($url->path_segments)[-1]; + if (!defined($file) || !length($file)) { + $file = "index"; + my $suffix = media_suffix($res->content_type); + $file .= ".$suffix" if $suffix; + } + elsif ($url->scheme eq 'ftp' + || $file =~ /\.t[bg]z$/ + || $file =~ /\.tar(\.(Z|gz|bz2?))?$/) + { + # leave the filename as it was + } + else { + my $ct = guess_media_type($file); + unless ($ct eq $res->content_type) { + + # need a better suffix for this type + my $suffix = media_suffix($res->content_type); + $file .= ".$suffix" if $suffix; + } + } + } + + # validate that we don't have a harmful filename now. The server + # might try to trick us into doing something bad. + if (!length($file) + || $file + =~ s/([^a-zA-Z0-9_\.\-\+\~])/sprintf "\\x%02x", ord($1)/ge + || $file =~ /^\./) + { + die + "Will not save <$url> as \"$file\".\nPlease override file name on the command line.\n"; + } + + if (defined $directory) { + require File::Spec; + $file = File::Spec->catfile($directory, $file); + } + + # Check if the file is already present + if (-l $file) { + die + "Will not save <$url> to link \"$file\".\nPlease override file name on the command line.\n"; + } + elsif (-f _) { + die + "Will not save <$url> as \"$file\" without verification.\nEither run from terminal or override file name on the command line.\n" + unless -t; + $shown = 1; + print "Overwrite $file? [y] "; + my $ans = ; + unless (defined($ans) && $ans =~ /^y?\n/) { + if (defined $ans) { + print "Ok, aborting.\n"; + } + else { + print "\nAborting.\n"; + } + exit 1; + } + $shown = 0; + } + elsif (-e _) { + die "Will not save <$url> as \"$file\". Path exists.\n"; + } + else { + print "Saving to '$file'...\n"; + use Fcntl qw(O_WRONLY O_EXCL O_CREAT); + sysopen(FILE, $file, O_WRONLY | O_EXCL | O_CREAT) + || die "Can't open $file: $!"; + } + } + else { + $file = $argfile; + } + unless (fileno(FILE)) { + open(FILE, ">", $file) || die "Can't open $file: $!\n"; + } + binmode FILE unless $opt{a}; + $length = $res->content_length; + $flength = fbytes($length) if defined $length; + $start_t = time; + $last_dur = 0; + } + + print FILE $_[0] or die "Can't write to $file: $!\n"; + $size += length($_[0]); + + if (defined $length) { + my $dur = time - $start_t; + if ($dur != $last_dur) { # don't update too often + $last_dur = $dur; + my $perc = $size / $length; + my $speed; + $speed = fbytes($size / $dur) . "/sec" if $dur > 3; + my $secs_left = fduration($dur / $perc - $dur); + $perc = int($perc * 100); + my $show = "$perc% of $flength"; + $show .= " (at $speed, $secs_left remaining)" if $speed; + show($show, 1); + } + } + else { + show(fbytes($size) . " received"); + } + } ); if (fileno(FILE)) { close(FILE) || die "Can't write to $file: $!\n"; - show(""); # clear text + show(""); # clear text print "\r"; print fbytes($size); print " of ", fbytes($length) if defined($length) && $length != $size; print " received"; my $dur = time - $start_t; if ($dur) { - my $speed = fbytes($size/$dur) . "/sec"; - print " in ", fduration($dur), " ($speed)"; + my $speed = fbytes($size / $dur) . "/sec"; + print " in ", fduration($dur), " ($speed)"; } print "\n"; if (my $mtime = $res->last_modified) { - utime time, $mtime, $file; + utime time, $mtime, $file; } if ($res->header("X-Died") || !$res->is_success) { - if (my $died = $res->header("X-Died")) { - print "$died\n"; - } - if (-t) { - print "Transfer aborted. Delete $file? [n] "; - my $ans = ; - if (defined($ans) && $ans =~ /^y\n/) { - unlink($file) && print "Deleted.\n"; - } - elsif ($length > $size) { - print "Truncated file kept: ", fbytes($length - $size), " missing\n"; - } - else { - print "File kept.\n"; - } + if (my $died = $res->header("X-Died")) { + print "$died\n"; + } + if (-t) { + print "Transfer aborted. Delete $file? [n] "; + my $ans = ; + if (defined($ans) && $ans =~ /^y\n/) { + unlink($file) && print "Deleted.\n"; + } + elsif ($length > $size) { + print "Truncated file kept: ", fbytes($length - $size), + " missing\n"; + } + else { + print "File kept.\n"; + } exit 1; - } - else { - print "Transfer aborted, $file kept\n"; - } + } + else { + print "Transfer aborted, $file kept\n"; + } } exit 0; } @@ -274,37 +287,35 @@ else { exit 1; -sub fbytes -{ +sub fbytes { my $n = int(shift); if ($n >= 1024 * 1024) { - return sprintf "%.3g MB", $n / (1024.0 * 1024); + return sprintf "%.3g MB", $n / (1024.0 * 1024); } elsif ($n >= 1024) { - return sprintf "%.3g KB", $n / 1024.0; + return sprintf "%.3g KB", $n / 1024.0; } else { - return "$n bytes"; + return "$n bytes"; } } -sub fduration -{ +sub fduration { use integer; my $secs = int(shift); - my $hours = $secs / (60*60); - $secs -= $hours * 60*60; + my $hours = $secs / (60 * 60); + $secs -= $hours * 60 * 60; my $mins = $secs / 60; $secs %= 60; if ($hours) { - return "$hours hours $mins minutes"; + return "$hours hours $mins minutes"; } elsif ($mins >= 2) { - return "$mins minutes"; + return "$mins minutes"; } else { - $secs += $mins * 60; - return "$secs seconds"; + $secs += $mins * 60; + return "$secs seconds"; } } @@ -313,17 +324,12 @@ BEGIN { my @ani = qw(- \ | /); my $ani = 0; - sub show - { - my($mess, $show_ani) = @_; + sub show { + my ($mess, $show_ani) = @_; print "\r$mess" . (" " x (75 - length $mess)); - print $show_ani ? "$ani[$ani++]\b" : " "; + my $msg = $show_ani ? $ani[$ani++]. "\b" : ' '; + print $msg; $ani %= @ani; $shown++; } } - -sub usage -{ - die "Usage: $progname [-a] []\n"; -} diff --git a/bin/lwp-dump b/bin/lwp-dump index 0245841..a161414 100755 --- a/bin/lwp-dump +++ b/bin/lwp-dump @@ -1,19 +1,15 @@ -#!/usr/bin/perl -w +#!/usr/bin/perl use strict; +use warnings; use LWP::UserAgent (); use Getopt::Long qw(GetOptions); use Encode; use Encode::Locale; -GetOptions(\my %opt, - 'parse-head', - 'max-length=n', - 'keep-client-headers', - 'method=s', - 'agent=s', - 'request', -) || usage(); +GetOptions(\my %opt, 'parse-head', 'max-length=n', 'keep-client-headers', + 'method=s', 'agent=s', 'request',) + || usage(); my $url = shift || usage(); @ARGV && usage(); @@ -37,15 +33,15 @@ EOT my $ua = LWP::UserAgent->new( parse_head => $opt{'parse-head'} || 0, keep_alive => 1, - env_proxy => 1, - agent => $opt{agent} || "lwp-dump/$LWP::UserAgent::VERSION ", + env_proxy => 1, + agent => $opt{agent} || "lwp-dump/$LWP::UserAgent::VERSION ", ); my $req = HTTP::Request->new($opt{method} || 'GET' => decode(locale => $url)); my $res = $ua->simple_request($req); $res->remove_header(grep /^Client-/, $res->header_field_names) - unless $opt{'keep-client-headers'} or - ($res->header("Client-Warning") || "") eq "Internal response"; + unless $opt{'keep-client-headers'} + or ($res->header("Client-Warning") || "") eq "Internal response"; if ($opt{request}) { $res->request->dump; diff --git a/bin/lwp-mirror b/bin/lwp-mirror index 51c6d3b..42fc71a 100755 --- a/bin/lwp-mirror +++ b/bin/lwp-mirror @@ -1,4 +1,4 @@ -#!/usr/bin/perl -w +#!/usr/bin/perl # Simple mirror utility using LWP @@ -37,27 +37,25 @@ Gisle Aas =cut - +use strict; +use warnings; use LWP::Simple qw(mirror is_success status_message $ua); use Getopt::Std; use Encode; use Encode::Locale; -$progname = $0; -$progname =~ s,.*/,,; # use basename only -$progname =~ s/\.\w*$//; #strip extension if any - -$opt_h = undef; # print usage -$opt_v = undef; # print version -$opt_t = undef; # timeout +my $progname = $0; +$progname =~ s,.*/,,; # use basename only +$progname =~ s/\.\w*$//; #strip extension if any -unless (getopts("hvt:")) { +my %opts; +unless (getopts("hvt:", \%opts)) { usage(); } -if ($opt_v) { +if ($opts{v}) { require LWP; - my $DISTNAME = 'libwww-perl-' . LWP::Version(); + my $DISTNAME = 'libwww-perl-' . $LWP::VERSION; die <<"EOT"; This is lwp-mirror version $LWP::Simple::VERSION ($DISTNAME) @@ -68,23 +66,26 @@ modify it under the same terms as Perl itself. EOT } -$url = decode(locale => shift) or usage(); -$file = encode(locale_fs => decode(locale => shift)) or usage(); -usage() if $opt_h or @ARGV; - -if (defined $opt_t) { - $opt_t =~ /^(\d+)([smh])?/; - die "$progname: Illegal timeout value!\n" unless defined $1; - $timeout = $1; - $timeout *= 60 if ($2 eq "m"); - $timeout *= 3600 if ($2 eq "h"); - $ua->timeout($timeout); +my $url = decode(locale => shift) or usage(); +my $file = encode(locale_fs => decode(locale => shift)) or usage(); +usage() if $opts{h} or @ARGV; + +if ($opts{t}) { + if ($opts{t} =~ /^(\d+)([smh])?/) { + my $timeout = $1; + $timeout *= 60 if ($2 eq "m"); + $timeout *= 3600 if ($2 eq "h"); + $ua->timeout($timeout); + } + else { + die "$progname: Illegal timeout value!\n"; + } } -$rc = mirror($url, $file); +my $rc = mirror($url, $file); if ($rc == 304) { - print STDERR "$progname: $file is up to date\n" + print STDERR "$progname: $file is up to date\n"; } elsif (!is_success($rc)) { print STDERR "$progname: $rc ", status_message($rc), " ($url)\n"; @@ -93,8 +94,7 @@ elsif (!is_success($rc)) { exit; -sub usage -{ +sub usage { die <<"EOT"; Usage: $progname [-options] -v print version number of program diff --git a/bin/lwp-request b/bin/lwp-request index 33af1e7..2869baf 100755 --- a/bin/lwp-request +++ b/bin/lwp-request @@ -1,4 +1,4 @@ -#!/usr/bin/perl -w +#!/usr/bin/perl # Simple user agent using LWP library. @@ -180,9 +180,12 @@ Gisle Aas =cut -$progname = $0; -$progname =~ s,.*[\\/],,; # use basename only -$progname =~ s/\.\w*$//; # strip extension, if any +use strict; +use warnings; + +my $progname = $0; +$progname =~ s,.*[\\/],,; # use basename only +$progname =~ s/\.\w*$//; # strip extension, if any require LWP; @@ -202,88 +205,89 @@ use HTTP::Date qw(time2str str2time); # # "" = No content in request, "C" = Needs content in request # -%allowed_methods = ( - GET => "", - HEAD => "", - POST => "C", - PUT => "C", - DELETE => "", - TRACE => "", - OPTIONS => "", +my %allowed_methods = ( + GET => "", + HEAD => "", + POST => "C", + PUT => "C", + DELETE => "", + TRACE => "", + OPTIONS => "", ); +my %options; # We make our own specialization of LWP::UserAgent that asks for # user/password if document is protected. { + package RequestAgent; -$RequestAgent::VERSION = '6.25'; -use base qw(LWP::UserAgent); - - sub new - { - my $self = LWP::UserAgent::new(@_); - $self->agent("lwp-request/$LWP::VERSION "); - $self; +$RequestAgent::VERSION = '6.27'; +use strict; + use warnings; + use base qw(LWP::UserAgent); + + sub new { + my $self = LWP::UserAgent::new(@_); + $self->agent("lwp-request/$LWP::VERSION "); + $self; } - sub get_basic_credentials - { - my($self, $realm, $uri) = @_; - if ($main::options{'C'}) { - return split(':', $main::options{'C'}, 2); - } - elsif (-t) { - my $netloc = $uri->host_port; - print STDERR "Enter username for $realm at $netloc: "; - my $user = ; - chomp($user); - return (undef, undef) unless length $user; - print STDERR "Password: "; - system("stty -echo"); - my $password = ; - system("stty echo"); - print STDERR "\n"; # because we disabled echo - chomp($password); - return ($user, $password); - } - else { - return (undef, undef) - } + sub get_basic_credentials { + my ($self, $realm, $uri) = @_; + if ($options{'C'}) { + return split(':', $options{'C'}, 2); + } + elsif (-t) { + my $netloc = $uri->host_port; + print STDERR "Enter username for $realm at $netloc: "; + my $user = ; + chomp($user); + return (undef, undef) unless length $user; + print STDERR "Password: "; + system("stty -echo"); + my $password = ; + system("stty echo"); + print STDERR "\n"; # because we disabled echo + chomp($password); + return ($user, $password); + } + else { + return (undef, undef); + } } } -$method = uc(lc($progname) eq "lwp-request" ? "GET" : $progname); +my $method = uc(lc($progname) eq "lwp-request" ? "GET" : $progname); # Parse command line use Getopt::Long; - my @getopt_args = ( - 'a', # content i/o in text(ascii) mode - 'm=s', # set method - 'f', # make request even if method is not in %allowed_methods - 'b=s', # base url - 't=s', # timeout - 'i=s', # if-modified-since - 'c=s', # content type for POST - 'C=s', # credentials for basic authorization - 'H=s@', # extra headers, form "Header: value string" - # - 'u', # display method and URL of request - 'U', # display request headers also - 's', # display status code - 'S', # display whole chain of status codes - 'e', # display response headers (default for HEAD) - 'E', # display whole chain of headers - 'd', # don't display content - # - 'h', # print usage - 'v', # print version - # - 'p=s', # proxy URL - 'P', # don't load proxy setting from environment - # - 'o=s', # output format + 'a', # content i/o in text(ascii) mode + 'm=s', # set method + 'f', # make request even if method is not in %allowed_methods + 'b=s', # base url + 't=s', # timeout + 'i=s', # if-modified-since + 'c=s', # content type for POST + 'C=s', # credentials for basic authorization + 'H=s@', # extra headers, form "Header: value string" + # + 'u', # display method and URL of request + 'U', # display request headers also + 's', # display status code + 'S', # display whole chain of status codes + 'e', # display response headers (default for HEAD) + 'E', # display whole chain of headers + 'd', # don't display content + # + 'h', # print usage + 'v', # print version + # + 'p=s', # proxy URL + 'P', # don't load proxy setting from environment + # + 'o=s', # output format ); Getopt::Long::config("noignorecase", "bundling"); @@ -292,7 +296,7 @@ unless (GetOptions(\%options, @getopt_args)) { } if ($options{'v'}) { require LWP; - my $DISTNAME = 'libwww-perl-' . LWP::Version(); + my $DISTNAME = 'libwww-perl-' . $LWP::VERSION; die <<"EOT"; This is lwp-request version $LWP::VERSION ($DISTNAME) @@ -306,7 +310,7 @@ EOT usage() if $options{'h'} || !@ARGV; # Create the user agent object -$ua = RequestAgent->new; +my $ua = RequestAgent->new; # Load proxy settings from *_proxy environment variables. $ua->env_proxy unless $options{'P'}; @@ -315,7 +319,7 @@ $method = uc($options{'m'}) if defined $options{'m'}; if ($options{'f'}) { if ($options{'c'}) { - $allowed_methods{$method} = "C"; # force content + $allowed_methods{$method} = "C"; # force content } else { $allowed_methods{$method} = ""; @@ -345,7 +349,7 @@ $options{'s'} = 1 if $options{'e'}; if (defined $options{'t'}) { $options{'t'} =~ /^(\d+)([smh])?/; die "$progname: Illegal timeout value!\n" unless defined $1; - $timeout = $1; + my $timeout = $1; if (defined $2) { $timeout *= 60 if $2 eq "m"; $timeout *= 3600 if $2 eq "h"; @@ -354,6 +358,7 @@ if (defined $options{'t'}) { } if (defined $options{'i'}) { + my $time; if (-e $options{'i'}) { $time = (stat _)[9]; } @@ -365,20 +370,23 @@ if (defined $options{'i'}) { $options{'i'} = time2str($time); } -$content = undef; -$user_ct = undef; +my $content; +my $user_ct; if ($allowed_methods{$method} eq "C") { + # This request needs some content unless (defined $options{'c'}) { + # set default content type - $options{'c'} = ($method eq "POST") ? - "application/x-www-form-urlencoded" + $options{'c'} + = ($method eq "POST") + ? "application/x-www-form-urlencoded" : "text/plain"; } else { die "$progname: Illegal Content-type format\n" unless $options{'c'} =~ m,^[\w\-]+/[\w\-.+]+(?:\s*;.*)?$,; - $user_ct++; + $user_ct++; } print STDERR "Please enter content ($options{'c'}) to be ${method}ed:\n" if -t; @@ -391,31 +399,32 @@ else { } # Set up a request. We will use the same request object for all URLs. -$request = HTTP::Request->new($method); +my $request = HTTP::Request->new($method); $request->header('If-Modified-Since', $options{'i'}) if defined $options{'i'}; -for my $user_header (@{ $options{'H'} || [] }) { +for my $user_header (@{$options{'H'} || []}) { my ($header_name, $header_value) = split /\s*:\s*/, $user_header, 2; $header_name =~ s/^\s+//; if (lc($header_name) eq "user-agent") { - $header_value .= $ua->agent if $header_value =~ /\s\z/; - $ua->agent($header_value); + $header_value .= $ua->agent if $header_value =~ /\s\z/; + $ua->agent($header_value); } else { - $request->push_header($header_name, $header_value); + $request->push_header($header_name, $header_value); } } + #$request->header('Accept', '*/*'); -if ($options{'c'}) { # will always be set for request that wants content +if ($options{'c'}) { # will always be set for request that wants content my $header = ($user_ct ? 'header' : 'init_header'); $request->$header('Content-Type', $options{'c'}); - $request->header('Content-Length', length $content); # Not really needed + $request->header('Content-Length', length $content); # Not really needed $request->content($content); } -$errors = 0; +my $errors = 0; sub show { - my $r = shift; + my $r = shift; my $last = shift; print $method, " ", $r->request->uri->as_string, "\n" if $options{'u'}; print $r->request->headers_as_string, "\n" if $options{'U'}; @@ -424,92 +433,94 @@ sub show { } # Ok, now we perform the requests, one URL at a time -while ($url = shift) { +while (my $url = shift) { + # Create the URL object, but protect us against bad URLs eval { - if ($url =~ /^\w+:/ || $options{'b'}) { # is there any scheme specification - $url = URI->new(decode(locale => $url), decode(locale => $options{'b'})); - $url = $url->abs(decode(locale => $options{'b'})) if $options{'b'}; - } - else { - $url = uf_uri($url); + if ($url =~ /^\w+:/ || $options{'b'}) + { # is there any scheme specification + $url = URI->new(decode(locale => $url), + decode(locale => $options{'b'})); + $url = $url->abs(decode(locale => $options{'b'})) if $options{'b'}; + } + else { + $url = uf_uri($url); } }; if ($@) { - $@ =~ s/ at .* line \d+.*//; - print STDERR $@; - $errors++; - next; + $@ =~ s/ at .* line \d+.*//; + print STDERR $@; + $errors++; + next; } $ua->proxy($url->scheme, decode(locale => $options{'p'})) if $options{'p'}; # Send the request and get a response back from the server $request->uri($url); - $response = $ua->request($request); + my $response = $ua->request($request); if ($options{'S'}) { for my $r ($response->redirects) { - show($r); + show($r); } } show($response, $options{'e'}); unless ($options{'d'}) { - if ($options{'o'} && - $response->content_type eq 'text/html') { - eval { - require HTML::Parse; - }; - if ($@) { - if ($@ =~ m,^Can't locate HTML/Parse.pm in \@INC,) { - die "The HTML-Tree distribution need to be installed for the -o option to be used.\n"; - } - else { - die $@; - } - } - my $html = HTML::Parse::parse_html($response->content); - { - $options{'o'} eq 'ps' && do { - require HTML::FormatPS; - my $f = HTML::FormatPS->new; - print $f->format($html); - last; - }; - $options{'o'} eq 'text' && do { - require HTML::FormatText; - my $f = HTML::FormatText->new; - print $f->format($html); - last; - }; - $options{'o'} eq 'html' && do { - print $html->as_HTML; - last; - }; - $options{'o'} eq 'links' && do { - my $base = $response->base; - $base = $options{'b'} if $options{'b'}; - for ( @{ $html->extract_links } ) { - my($link, $elem) = @$_; - my $tag = uc $elem->tag; - $link = URI->new($link)->abs($base)->as_string; - print "$tag\t$link\n"; - } - last; - }; - $options{'o'} eq 'dump' && do { - $html->dump; - last; - }; - # It is bad to not notice this before now :-( - die "Illegal -o option value ($options{'o'})\n"; - } - } - else { - binmode STDOUT unless $options{'a'}; - print $response->content; - } + if ($options{'o'} && $response->content_type eq 'text/html') { + eval { require HTML::Parse; }; + if ($@) { + if ($@ =~ m,^Can't locate HTML/Parse.pm in \@INC,) { + die + "The HTML-Tree distribution need to be installed for the -o option to be used.\n"; + } + else { + die $@; + } + } + my $html = HTML::Parse::parse_html($response->content); + { + $options{'o'} eq 'ps' && do { + require HTML::FormatPS; + my $f = HTML::FormatPS->new; + print $f->format($html); + last; + }; + $options{'o'} eq 'text' && do { + require HTML::FormatText; + my $f = HTML::FormatText->new; + print $f->format($html); + last; + }; + $options{'o'} eq 'html' && do { + print $html->as_HTML; + last; + }; + $options{'o'} eq 'links' && do { + my $base = $response->base; + $base = $options{'b'} if $options{'b'}; + for (@{$html->extract_links}) { + my ($link, $elem) = @$_; + my $tag = uc $elem->tag; + $link = URI->new($link)->abs($base)->as_string; + print "$tag\t$link\n"; + } + last; + }; + $options{'o'} eq 'dump' && do { + $html->dump; + last; + }; + + # It is bad to not notice this before now :-( + die "Illegal -o option value ($options{'o'})\n"; + } + } + else { + binmode STDOUT unless $options{'a'}; + print $response->content; + } } $errors++ unless $response->is_success; @@ -518,8 +529,7 @@ while ($url = shift) { exit $errors; -sub usage -{ +sub usage { die <<"EOT"; Usage: $progname [-options] ... -m use method for the request (default is '$method') diff --git a/dist.ini b/dist.ini index 581f07f..be53433 100644 --- a/dist.ini +++ b/dist.ini @@ -4,7 +4,7 @@ license = Perl_5 copyright_holder = Gisle Aas copyright_year = 1995 -version = 6.25 +version = 6.27 ; Gather stuff in [Git::GatherDir] @@ -49,6 +49,7 @@ allow_dirty = README.md [Git::Contributors] [GithubMeta] +issues = 1 user = libwww-perl [Authority] do_munging = 0 diff --git a/lib/LWP.pm b/lib/LWP.pm index b3a174a..7fb6e75 100644 --- a/lib/LWP.pm +++ b/lib/LWP.pm @@ -1,6 +1,6 @@ package LWP; -our $VERSION = '6.25'; +our $VERSION = '6.27'; require LWP::UserAgent; # this should load everything you need diff --git a/lib/LWP/Authen/Basic.pm b/lib/LWP/Authen/Basic.pm index 18fe8cd..b4cf986 100644 --- a/lib/LWP/Authen/Basic.pm +++ b/lib/LWP/Authen/Basic.pm @@ -1,5 +1,5 @@ package LWP::Authen::Basic; -$LWP::Authen::Basic::VERSION = '6.25'; +$LWP::Authen::Basic::VERSION = '6.27'; use strict; require MIME::Base64; diff --git a/lib/LWP/Authen/Digest.pm b/lib/LWP/Authen/Digest.pm index 2e80af4..d0389e9 100644 --- a/lib/LWP/Authen/Digest.pm +++ b/lib/LWP/Authen/Digest.pm @@ -1,5 +1,5 @@ package LWP::Authen::Digest; -$LWP::Authen::Digest::VERSION = '6.25'; +$LWP::Authen::Digest::VERSION = '6.27'; use strict; use base 'LWP::Authen::Basic'; diff --git a/lib/LWP/Authen/Ntlm.pm b/lib/LWP/Authen/Ntlm.pm index 7fd0a82..d6afd1c 100644 --- a/lib/LWP/Authen/Ntlm.pm +++ b/lib/LWP/Authen/Ntlm.pm @@ -2,7 +2,7 @@ package LWP::Authen::Ntlm; use strict; -our $VERSION = '6.25'; +our $VERSION = '6.27'; use Authen::NTLM "1.02"; use MIME::Base64 "2.12"; diff --git a/lib/LWP/ConnCache.pm b/lib/LWP/ConnCache.pm index 172e2f4..89281ec 100644 --- a/lib/LWP/ConnCache.pm +++ b/lib/LWP/ConnCache.pm @@ -2,7 +2,7 @@ package LWP::ConnCache; use strict; -our $VERSION = '6.25'; +our $VERSION = '6.27'; our $DEBUG; sub new { diff --git a/lib/LWP/Debug.pm b/lib/LWP/Debug.pm index f7334c4..62a5306 100644 --- a/lib/LWP/Debug.pm +++ b/lib/LWP/Debug.pm @@ -1,5 +1,5 @@ package LWP::Debug; # legacy -$LWP::Debug::VERSION = '6.25'; +$LWP::Debug::VERSION = '6.27'; require Exporter; our @ISA = qw(Exporter); our @EXPORT_OK = qw(level trace debug conns); diff --git a/lib/LWP/Debug/TraceHTTP.pm b/lib/LWP/Debug/TraceHTTP.pm index 4dc70a0..c0992b5 100644 --- a/lib/LWP/Debug/TraceHTTP.pm +++ b/lib/LWP/Debug/TraceHTTP.pm @@ -1,5 +1,5 @@ package LWP::Debug::TraceHTTP; -$LWP::Debug::TraceHTTP::VERSION = '6.25'; +$LWP::Debug::TraceHTTP::VERSION = '6.27'; # Just call: # # require LWP::Debug::TraceHTTP; @@ -11,8 +11,9 @@ $LWP::Debug::TraceHTTP::VERSION = '6.25'; use strict; use base 'LWP::Protocol::http'; -package LWP::Debug::TraceHTTP::Socket; -$LWP::Debug::TraceHTTP::Socket::VERSION = '6.25'; +package # hide from PAUSE + LWP::Debug::TraceHTTP::Socket; + use Data::Dump 1.13; use Data::Dump::Trace qw(autowrap mcall); diff --git a/lib/LWP/DebugFile.pm b/lib/LWP/DebugFile.pm index 681415f..6575603 100644 --- a/lib/LWP/DebugFile.pm +++ b/lib/LWP/DebugFile.pm @@ -1,5 +1,5 @@ package LWP::DebugFile; -$LWP::DebugFile::VERSION = '6.25'; +$LWP::DebugFile::VERSION = '6.27'; # legacy stub 1; diff --git a/lib/LWP/MemberMixin.pm b/lib/LWP/MemberMixin.pm index d56a2e8..c3cd034 100644 --- a/lib/LWP/MemberMixin.pm +++ b/lib/LWP/MemberMixin.pm @@ -1,5 +1,5 @@ package LWP::MemberMixin; -$LWP::MemberMixin::VERSION = '6.25'; +$LWP::MemberMixin::VERSION = '6.27'; sub _elem { my $self = shift; my $elem = shift; diff --git a/lib/LWP/Protocol.pm b/lib/LWP/Protocol.pm index 3adbaf3..f3dbf18 100644 --- a/lib/LWP/Protocol.pm +++ b/lib/LWP/Protocol.pm @@ -2,7 +2,7 @@ package LWP::Protocol; use base 'LWP::MemberMixin'; -our $VERSION = '6.25'; +our $VERSION = '6.27'; use strict; use Carp (); diff --git a/lib/LWP/Protocol/cpan.pm b/lib/LWP/Protocol/cpan.pm index 3288abd..e8ddaad 100644 --- a/lib/LWP/Protocol/cpan.pm +++ b/lib/LWP/Protocol/cpan.pm @@ -1,5 +1,5 @@ package LWP::Protocol::cpan; -$LWP::Protocol::cpan::VERSION = '6.25'; +$LWP::Protocol::cpan::VERSION = '6.27'; use strict; use base qw(LWP::Protocol); diff --git a/lib/LWP/Protocol/data.pm b/lib/LWP/Protocol/data.pm index 3b25652..0676b46 100644 --- a/lib/LWP/Protocol/data.pm +++ b/lib/LWP/Protocol/data.pm @@ -1,5 +1,5 @@ package LWP::Protocol::data; -$LWP::Protocol::data::VERSION = '6.25'; +$LWP::Protocol::data::VERSION = '6.27'; # Implements access to data:-URLs as specified in RFC 2397 use strict; diff --git a/lib/LWP/Protocol/file.pm b/lib/LWP/Protocol/file.pm index e83149d..6abb3dc 100644 --- a/lib/LWP/Protocol/file.pm +++ b/lib/LWP/Protocol/file.pm @@ -1,5 +1,5 @@ package LWP::Protocol::file; -$LWP::Protocol::file::VERSION = '6.25'; +$LWP::Protocol::file::VERSION = '6.27'; use base qw(LWP::Protocol); use strict; diff --git a/lib/LWP/Protocol/ftp.pm b/lib/LWP/Protocol/ftp.pm index 2a96c1b..dab5b42 100644 --- a/lib/LWP/Protocol/ftp.pm +++ b/lib/LWP/Protocol/ftp.pm @@ -1,5 +1,5 @@ package LWP::Protocol::ftp; -$LWP::Protocol::ftp::VERSION = '6.25'; +$LWP::Protocol::ftp::VERSION = '6.27'; # Implementation of the ftp protocol (RFC 959). We let the Net::FTP # package do all the dirty work. use base qw(LWP::Protocol); @@ -16,7 +16,7 @@ use File::Listing (); { package LWP::Protocol::MyFTP; -$LWP::Protocol::MyFTP::VERSION = '6.25'; +$LWP::Protocol::MyFTP::VERSION = '6.27'; use strict; use base qw(Net::FTP); diff --git a/lib/LWP/Protocol/gopher.pm b/lib/LWP/Protocol/gopher.pm index e6fe5ce..6b3ad07 100644 --- a/lib/LWP/Protocol/gopher.pm +++ b/lib/LWP/Protocol/gopher.pm @@ -1,5 +1,5 @@ package LWP::Protocol::gopher; -$LWP::Protocol::gopher::VERSION = '6.25'; +$LWP::Protocol::gopher::VERSION = '6.27'; # Implementation of the gopher protocol (RFC 1436) # # This code is based on 'wwwgopher.pl,v 0.10 1994/10/17 18:12:34 shelden' diff --git a/lib/LWP/Protocol/http.pm b/lib/LWP/Protocol/http.pm index 2266b1e..9632dc3 100644 --- a/lib/LWP/Protocol/http.pm +++ b/lib/LWP/Protocol/http.pm @@ -1,5 +1,5 @@ package LWP::Protocol::http; -$LWP::Protocol::http::VERSION = '6.25'; +$LWP::Protocol::http::VERSION = '6.27'; use strict; require HTTP::Response; @@ -497,8 +497,9 @@ sub request #----------------------------------------------------------- -package LWP::Protocol::http::SocketMethods; -$LWP::Protocol::http::SocketMethods::VERSION = '6.25'; +package # hide from PAUSE + LWP::Protocol::http::SocketMethods; + sub ping { my $self = shift; !$self->can_read(0); @@ -510,8 +511,9 @@ sub increment_response_count { } #----------------------------------------------------------- -package LWP::Protocol::http::Socket; -$LWP::Protocol::http::Socket::VERSION = '6.25'; +package # hide from PAUSE + LWP::Protocol::http::Socket; + use base qw(LWP::Protocol::http::SocketMethods Net::HTTP); 1; diff --git a/lib/LWP/Protocol/loopback.pm b/lib/LWP/Protocol/loopback.pm index f1e4c9f..92e787f 100644 --- a/lib/LWP/Protocol/loopback.pm +++ b/lib/LWP/Protocol/loopback.pm @@ -1,5 +1,5 @@ package LWP::Protocol::loopback; -$LWP::Protocol::loopback::VERSION = '6.25'; +$LWP::Protocol::loopback::VERSION = '6.27'; use strict; require HTTP::Response; diff --git a/lib/LWP/Protocol/mailto.pm b/lib/LWP/Protocol/mailto.pm index 9358695..14bd21c 100644 --- a/lib/LWP/Protocol/mailto.pm +++ b/lib/LWP/Protocol/mailto.pm @@ -1,5 +1,5 @@ package LWP::Protocol::mailto; -$LWP::Protocol::mailto::VERSION = '6.25'; +$LWP::Protocol::mailto::VERSION = '6.27'; # 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. diff --git a/lib/LWP/Protocol/nntp.pm b/lib/LWP/Protocol/nntp.pm index 9727a24..0469cde 100644 --- a/lib/LWP/Protocol/nntp.pm +++ b/lib/LWP/Protocol/nntp.pm @@ -1,5 +1,5 @@ package LWP::Protocol::nntp; -$LWP::Protocol::nntp::VERSION = '6.25'; +$LWP::Protocol::nntp::VERSION = '6.27'; # Implementation of the Network News Transfer Protocol (RFC 977) use base qw(LWP::Protocol); diff --git a/lib/LWP/Protocol/nogo.pm b/lib/LWP/Protocol/nogo.pm index a9b0e41..750c5b5 100644 --- a/lib/LWP/Protocol/nogo.pm +++ b/lib/LWP/Protocol/nogo.pm @@ -4,7 +4,7 @@ package LWP::Protocol::nogo; # LWP::Protocol::implementor(that_scheme, 'LWP::Protocol::nogo'); # For then on, attempts to access URLs with that scheme will generate # a 500 error. -$LWP::Protocol::nogo::VERSION = '6.25'; +$LWP::Protocol::nogo::VERSION = '6.27'; use strict; require HTTP::Response; diff --git a/lib/LWP/RobotUA.pm b/lib/LWP/RobotUA.pm index 0e96856..2e630bb 100644 --- a/lib/LWP/RobotUA.pm +++ b/lib/LWP/RobotUA.pm @@ -2,7 +2,7 @@ package LWP::RobotUA; use base qw(LWP::UserAgent); -our $VERSION = '6.25'; +our $VERSION = '6.27'; require WWW::RobotRules; require HTTP::Request; diff --git a/lib/LWP/Simple.pm b/lib/LWP/Simple.pm index 321f964..3d727e5 100644 --- a/lib/LWP/Simple.pm +++ b/lib/LWP/Simple.pm @@ -2,7 +2,7 @@ package LWP::Simple; use strict; -our $VERSION = '6.25'; +our $VERSION = '6.27'; require Exporter; diff --git a/lib/LWP/UserAgent.pm b/lib/LWP/UserAgent.pm index 07c3916..c7b868c 100644 --- a/lib/LWP/UserAgent.pm +++ b/lib/LWP/UserAgent.pm @@ -15,7 +15,7 @@ use LWP::Protocol (); use Scalar::Util qw(blessed); use Try::Tiny qw(try catch); -our $VERSION = '6.25'; +our $VERSION = '6.27'; sub new { @@ -660,13 +660,11 @@ sub redirect_ok return 1; } - -sub credentials -{ - my $self = shift; - my $netloc = lc(shift); - my $realm = shift || ""; - my $old = $self->{basic_authentication}{$netloc}{$realm}; +sub credentials { + my $self = shift; + my $netloc = lc(shift || ''); + my $realm = shift || ""; + my $old = $self->{basic_authentication}{$netloc}{$realm}; if (@_) { $self->{basic_authentication}{$netloc}{$realm} = [@_]; } @@ -675,7 +673,6 @@ sub credentials return join(":", @$old); } - sub get_basic_credentials { my($self, $realm, $uri, $proxy) = @_; diff --git a/lwpcook.pod b/lwpcook.pod index 43af716..b4d4989 100644 --- a/lwpcook.pod +++ b/lwpcook.pod @@ -97,7 +97,7 @@ operation is to access a WWW form application: $ua = LWP::UserAgent->new; my $req = HTTP::Request->new( - POST => 'http://rt.cpan.org/Public/Dist/Display.html'); + POST => 'https://rt.cpan.org/Public/Dist/Display.html'); $req->content_type('application/x-www-form-urlencoded'); $req->content('Status=Active&Name=libwww-perl'); @@ -112,7 +112,7 @@ suitable default for the content_type: use LWP::UserAgent; $ua = LWP::UserAgent->new; - my $req = POST 'http://rt.cpan.org/Public/Dist/Display.html', + my $req = POST 'https://rt.cpan.org/Public/Dist/Display.html', [ Status => 'Active', Name => 'libwww-perl' ]; print $ua->request($req)->as_string; @@ -185,7 +185,9 @@ program for an example of this. 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. +and respond to cookie requests if you set up a cookie jar. LWP doesn't +provide a cookie jar itself, but if you install L, +it can be used like this: use LWP::UserAgent; use HTTP::CookieJar::LWP; @@ -258,7 +260,7 @@ name): $ua = LWP::UserAgent->new; my $req = HTTP::Request->new(GET => - 'http://www.cpan.org/authors/Gisle_Aas/libwww-perl-6.02.tar.gz'); + 'http://www.cpan.org/CPAN/authors/id/O/OA/OALDERS/libwww-perl-6.26.tar.gz'); $res = $ua->request($req, "libwww-perl.tar.gz"); if ($res->is_success) { print "ok\n"; @@ -273,7 +275,7 @@ argument is a code reference): use LWP::UserAgent; $ua = LWP::UserAgent->new; - $URL = 'ftp://ftp.unit.no/pub/rfc/rfc-index.txt'; + $URL = 'ftp://ftp.isc.org/pub/rfc/rfc-index.txt'; my $expected_length; my $bytes_received = 0; diff --git a/t/10-attrs.t b/t/10-attrs.t new file mode 100644 index 0000000..0567266 --- /dev/null +++ b/t/10-attrs.t @@ -0,0 +1,47 @@ +use strict; +use warnings; +use Test::More; + +use LWP::UserAgent; +plan tests => 9; + +# Prevent environment from interfering with test: +delete $ENV{PERL_LWP_SSL_VERIFY_HOSTNAME}; +delete $ENV{HTTPS_CA_FILE}; +delete $ENV{HTTPS_CA_DIR}; +delete $ENV{PERL_LWP_SSL_CA_FILE}; +delete $ENV{PERL_LWP_SSL_CA_PATH}; +delete $ENV{PERL_LWP_ENV_PROXY}; + +# credentials +{ + my $ua = LWP::UserAgent->new(); + $ua->credentials(undef, 'my realm', 'user', 'pass'); + is($ua->credentials(undef, 'my realm'), 'user:pass', 'credentials: undef netloc'); + + $ua->credentials('example.com:80', undef, 'user', 'pass'); + is($ua->credentials('example.com:80', undef), 'user:pass', 'credentials: undef realm'); + + $ua->credentials('example.com:80', 'my realm', undef, 'pass'); + is($ua->credentials('example.com:80', 'my realm'), ':pass', 'credentials: undef username'); + + $ua->credentials('example.com:80', 'my realm', 'user', undef); + is($ua->credentials('example.com:80', 'my realm'), 'user:', 'credentials: undef pass'); + + $ua->credentials(undef, undef, 'user', 'pass'); + is($ua->credentials(undef, undef), 'user:pass', 'credentials: undef netloc and realm'); + + $ua->credentials(undef, undef, undef, undef); + is($ua->credentials(undef, undef), ':', 'credentials: undef all'); + + $ua->credentials('example.com:80', 'my realm', 'user', 'pass'); + is($ua->credentials('example.com:80', 'my realm'), 'user:pass', 'credentials: got proper creds for example:80'); + + # ask for the credentials incorrectly + my $creds = $ua->credentials('example.com'); + is($creds, undef, 'credentials: no realm on request for info'); + + # ask for the credentials incorrectly with bad realm + $creds = $ua->credentials('example.com', 'invalid'); + is($creds, undef, 'credentials: invalid realm on request for info'); +} diff --git a/t/local/get.t b/t/local/get.t index 73d3269..f3e7ef0 100644 --- a/t/local/get.t +++ b/t/local/get.t @@ -23,7 +23,7 @@ else { } if ( $TMPDIR ) { $TMPDIR =~ tr|\\|/|; - plan tests => 4; + plan tests => 7; } else { plan skip_all => 'Cannot test without a suitable TMP Directory'; @@ -64,6 +64,13 @@ getstore("file:$orig", $copy); $copytext = slurp( $copy ); is($copytext, $origtext, "getstore: Original and copy equal eachother"); +# Test get() function +is(get("file:$orig"), $origtext, "get: Returns the content"); + +# Test head() function +is(ref head("file:$orig"), "HTTP::Response", "head: Returns a HTTP::Response object when called in scalar context"); +is(@{[head("file:$orig")]}, 5, "head: Returns five headers when called in list context"); + unlink($orig); unlink($copy); diff --git a/xt/author/eol.t b/xt/author/eol.t index aed1716..21fab6d 100644 --- a/xt/author/eol.t +++ b/xt/author/eol.t @@ -36,6 +36,7 @@ my @files = ( 'lib/LWP/UserAgent.pm', 't/00-report-prereqs.dd', 't/00-report-prereqs.t', + 't/10-attrs.t', 't/base/default_content_type.t', 't/base/protocols.t', 't/base/protocols/nntp.t', diff --git a/xt/author/pod-coverage.t b/xt/author/pod-coverage.t index bf395d0..c57543e 100644 --- a/xt/author/pod-coverage.t +++ b/xt/author/pod-coverage.t @@ -26,21 +26,21 @@ plan skip_all => 'All the modules we found were excluded from POD coverage test. plan tests => scalar @modules; my %trustme = ( + 'LWP::UserAgent' => [ + qr/^(?:run_handlers|send_request|use_alarm|use_eval)$/ + ], + 'LWP::Protocol' => [ + qr/^(?:max_size|timeout)$/ + ], 'LWP::Protocol::http' => [ qr/^(?:hlist_remove|socket_class|socket_type)$/ ], - 'LWP::Protocol::gopher' => [ - qr/^(?:gopher2url|menu2html)$/ - ], 'LWP::RobotUA' => [ qr/^host_count$/ ], - 'LWP::Protocol' => [ - qr/^(?:max_size|timeout)$/ - ], - 'LWP::UserAgent' => [ - qr/^(?:run_handlers|send_request|use_alarm|use_eval)$/ - ] + 'LWP::Protocol::gopher' => [ + qr/^(?:gopher2url|menu2html)$/ + ] ); my @also_private; diff --git a/xt/author/pod-spell.t b/xt/author/pod-spell.t index 505033c..cc55379 100644 --- a/xt/author/pod-spell.t +++ b/xt/author/pod-spell.t @@ -93,6 +93,7 @@ INOUE Ian Jacob Jakub +James Jason Jeremy Joao @@ -116,6 +117,7 @@ Kilzer Klar Knop Koenig +Konojacki Koster Kronengold Krüger @@ -139,6 +141,7 @@ Mark Marko Markus Martijn +Martin Massjouni Mates Matthew @@ -181,6 +184,7 @@ Rabbitson Radoslaw Radu Rai +Raspass Rezic Robert RobotUA @@ -196,8 +200,10 @@ Simple Sjogren Skyttä Slaven +Sluka Spafford Spiros +Standish Steffen Steffen_Ullrich Steinbrunner @@ -216,6 +222,7 @@ Tilly Tim Todd Tom +Tomasz Tony Toru Tourbin @@ -264,6 +271,7 @@ david davidrw de denaxas +dnstandish dot dpettit dsteinbrunner @@ -288,6 +296,7 @@ jefflee jfesler jmates john9art +jraspass jwilk jwittkoski ka @@ -297,6 +306,8 @@ loopback lwp mailto mark +martin +me michael michealgong michiel diff --git a/xt/release/changes_has_content.t b/xt/release/changes_has_content.t index 3215f30..f966566 100644 --- a/xt/release/changes_has_content.t +++ b/xt/release/changes_has_content.t @@ -4,7 +4,7 @@ use Test::More tests => 2; note 'Checking Changes'; my $changes_file = 'Changes'; -my $newver = '6.25'; +my $newver = '6.27'; my $trial_token = '-TRIAL'; SKIP: { -- 2.34.1