view release on metacpan or  search on metacpan

lib/Cikl/Smrt/Fetchers/Http.pm  view on Meta::CPAN

    $ua->timeout($self->timeout());
    
    # work-around for what appears to be a threading / race condition
    $ua->max_redirect(0) if($feedurl->scheme() eq 'https');

    if(defined($self->verify_tls == 0)) {
        $ua->ssl_opts(SSL_verify_mode => 'SSL_VERIFY_NONE');
    } else {
        $ua->ssl_opts(SSL_verify_mode => 'SSL_VERIFY_PEER');
    }

    if(defined($self->feed_user)){
      my $auth = LWP::Authen::Basic->auth_header($self->feed_user, $self->feed_password);
      $ua->default_header("Authentication" => $auth);
    }
    
    # work-around for a bug in LWP::UserAgent
    delete($ua->{'ssl_opts'}->{'verify_hostname'});

    my $filename;

    my $is_tempfile = 0;
    if(my $mirror = $self->mirror){
      $feedurl->path() =~ m/\/([a-zA-Z0-9._-]+)$/;
      $filename = $mirror.'/'.$1;
    } else {
      $filename = tmpnam();
      # Try to ensure that it gets unlinked when the process exits.
      push(@__tempfiles, $filename);
      $is_tempfile = 1;
    }

    $logger->debug("Saving response to $filename");

    die($filename.' isn\'t writeable by our user') if(-e $filename && !-w $filename);

    my $response = $ua->mirror($feedurl->as_string(), $filename);

    if( $response->is_error()){
      die('failed to get feed: '.$feedurl->as_string()."\n".$response->status_line());
    }
    $ua = undef;
    my $fh = IO::File->new($filename, 'r') or die($!);
    if ($is_tempfile == 1) {
      # This looks strange, but since we still have the filehandle open, it 
      # won't really disappear until the handle is closed.
      unlink($filename);
    }
    return($fh);
}

sub env_proxy {
    my ($self) = @_;
    require Encode;
    require Encode::Locale;
    my($k,$v);
    my $found = 0;
    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;
        unless($k eq 'no') {
            # Ignore random _proxy variables, allow only valid schemes
            next unless $k =~ /^$URI::scheme_re\z/;
            # Ignore xxx_proxy variables if xxx isn't a supported protocol
            next unless LWP::Protocol::implementor($k);
            $found = 1;
        }
    }
    return $found;
}

__PACKAGE__->meta->make_immutable;

1;