view release on metacpan or  search on metacpan

lib/CPAN/Uploader.pm  view on Meta::CPAN

  $request->authorization_basic($self->{user}, $self->{password});

  my $DEBUG_METHOD = $ENV{CPAN_UPLOADER_DISPLAY_HTTP_BODY}
                   ? 'as_string'
                   : 'headers_as_string';

  $self->log_debug(
    "----- REQUEST BEGIN -----\n" .
    $request->$DEBUG_METHOD . "\n" .
    "----- REQUEST END -------\n"
  );

  # Make the request to the PAUSE web server
  $self->log("POSTing upload for $file to $uri");
  my $response = $agent->request($request);

  # So, how'd we do?
  if (not defined $response) {
    die "Request completely failed - we got undef back: $!";
  }

  if ($response->is_error) {
    if ($response->code == RC_NOT_FOUND) {
      die "PAUSE's CGI for handling messages seems to have moved!\n",
        "(HTTP response code of 404 from the ", $self->target, " web server)\n",
        "It used to be: ", $uri, "\n",
        "Please inform the maintainer of $self.\n";
    } else {
      die "request failed with error code ", $response->code,
        "\n  Message: ", $response->message, "\n";
    }
  } else {
    $self->log_debug($_) for (
      "Looks OK!",
      "----- RESPONSE BEGIN -----\n" .
      $response->$DEBUG_METHOD . "\n" .
      "----- RESPONSE END -------\n"
    );

    $self->log($self->target . " add message sent ok [" . $response->code . "]");
  }
}


#pod =method new
#pod
#pod   my $uploader = CPAN::Uploader->new(\%arg);
#pod
#pod This method returns a new uploader.  You probably don't need to worry about
#pod this method.
#pod
#pod Valid arguments are the same as those to C<upload_file>.
#pod
#pod =cut

sub new {
  my ($class, $arg) = @_;

  $arg->{$_} or Carp::croak("missing $_ argument") for qw(user password);
  bless $arg => $class;
}

#pod =method read_config_file
#pod
#pod   my $config = CPAN::Uploader->read_config_file( $filename );
#pod
#pod This reads the config file and returns a hashref of its contents that can be
#pod used as configuration for CPAN::Uploader.
#pod
#pod If no filename is given, it looks for F<.pause> in the user's home directory
#pod (from the env var C<HOME>, or the current directory if C<HOME> isn't set).
#pod
#pod See L<cpan-upload/CONFIGURATION> for the config format.
#pod
#pod =cut

sub _parse_dot_pause {
  my ($class, $filename) = @_;
  my %conf;
  open my $pauserc, '<', $filename
    or die "can't open $filename for reading: $!";

  while (<$pauserc>) {
    chomp;
    if (/BEGIN PGP MESSAGE/ ) {
      Carp::croak "$filename seems to be encrypted. "
      . "Maybe you need to install Config::Identity?"
    }

    next unless $_ and $_ !~ /^\s*#/;

    if (my ($k, $v) = /^\s*(\w+)\s+(.+)$/) {
      Carp::croak "multiple entries for $k" if $conf{$k};
      $conf{$k} = $v;
    }
    else {
      Carp::croak qq#Line $. ($_) does not match the "key value" format.#;
    }
  }
  return %conf;
}

sub read_config_file {
  my ($class, $filename) = @_;

  unless (defined $filename) {
    my $home = $^O eq 'MSWin32' && "$]" < 5.016
      ? $ENV{HOME} || $ENV{USERPROFILE}
      : (<~>)[0];
    $filename = File::Spec->catfile($home, '.pause');

    return {} unless -e $filename and -r _;
  }

  my %conf;
  if ( eval { require Config::Identity } ) {
    %conf = Config::Identity->load($filename);
    $conf{user} = delete $conf{username} unless $conf{user};
  }
  else { # Process .pause manually