view release on metacpan or  search on metacpan

lib/App/Chart/UserAgent.pm  view on Meta::CPAN

# Chart 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 Chart.  If not, see <http://www.gnu.org/licenses/>.

package App::Chart::UserAgent;
use 5.006;
use strict;
use warnings;
use App::Chart;
use Locale::TextDomain ('App-Chart');
use HTTP::Message 5.814;  # for decodable()
use base 'LWP::UserAgent';

use Class::Singleton 1.03; # 1.03 for _new_instance()
use base 'Class::Singleton';
*_new_instance = \&new;

# Crib notes:
#
# URIs:
#     Current RFC3986
#
#     Past RFC2396 -- previous URI spec
#          RFC1808 -- relative URI spec
#          RFC1738 -- previous again
#          RFC1736, RFC1737 -- functional specs
#
# Proxies:
#     /usr/share/doc/libwww-doc/html/Library/User/Using/Proxy.html
#         http_proxy, no_proxy
#         Eg. http_proxy=http://proxy.zipworld.com.au:8080/
#
#     /usr/share/doc/lynx/lynx_help/keystrokes/environments.html
#         shows spaces in no_proxy
#
#     wget.info Proxies
#
#
# something ...
# @LWP::Protocol::http::EXTRA_SOCK_OPTS = (PeerAddr => "foo.com");
#

# LWP::Protocol::http::EXTRA_SOCK_OPTS is used by LWP::Protocol::http
# when creating its I/O socket class.  That class is
# LWP::Protocol::http::Socket, which is a subclass Net::HTTP.
#
# Net::HTTP made an incompatible change, circa its version 6.23,
# to its default MaxLineLength, dropping from 32 kbytes to 8 kbytes.
# This breaks on some long header lines from finance.yahoo.com in
# App::Chart::Yahoo data downloads.  Those lines are somewhere up
# 6 kbytes, maybe more depending on the share symbol or something.
# That's a foolish amount to have in a header line, but want it to
# work here.
#
# MaxLineLength => 0 here means no length limit.
# Would have preferred to get this in via the UserAgent instance
# or class here, but looks like no way to get through to that
# protocol bits.
#
use LWP::Protocol::http;
push @LWP::Protocol::http::EXTRA_SOCK_OPTS, MaxLineLength => 0;


sub new {
  my ($class, %options) = @_;
  if (! exists $options{'keep_alive'}
      && ! exists $options{'conn_cache'}) {
    $options{'keep_alive'} = 1;  # connection cache 1 sock
  }
  if (! exists $options{'agent'}) {
    # not given, use our default
    $options{'agent'} = $class->_agent;
  } elsif (defined $options{'agent'} && $options{'agent'} =~ / $/) {
    # ends in space, append our default
    $options{'agent'} .= $class->_agent;
  }
  my $self = $class->SUPER::new (timeout => 60,  # seconds, default
                                 %options);

  # with lwp bit appended
  # $self->agent ();

  # ask for everything decoded_content() accepts
  $self->default_header ('Accept-Encoding' => scalar HTTP::Message::decodable());

  # trace on redirect ...

  return $self;
}

sub _agent {
  my ($class) = @_;
  return "Chart/$App::Chart::VERSION " . $class->SUPER::_agent;
}

sub redirect_ok {
  my ($self, $prospective_request, $response) = @_;
  my $ret = $self->SUPER::redirect_ok ($prospective_request, $response);
  if ($ret) {
    print "Redirect to ",$prospective_request->uri,"\n";
  }
  return $ret;
}

sub request {
  my ($self, @args) = @_;
  $self->{__PACKAGE__.'.last_time'} = time() - 1;  # provoke initial display
  return $self->SUPER::request (@args);
}

# method call up from LWP::UserAgent
sub progress {
  my ($self, $status, $response) = @_;

  my $str = $status;
  if ($status eq 'begin') {
    $str = __('connect');