view release on metacpan or  search on metacpan

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

use strict;
use warnings;
package CPAN::Uploader 0.103019;
# ABSTRACT: upload things to the CPAN

#pod =head1 ORIGIN
#pod
#pod This code is mostly derived from C<cpan-upload-http> by Brad Fitzpatrick, which
#pod in turn was based on C<cpan-upload> by Neil Bowers.  I (I<rjbs>) didn't want to
#pod have to use a C<system> call to run either of those, so I refactored the code
#pod into this module.
#pod
#pod =cut

use Carp ();
use File::Basename ();
use File::Spec;
use HTTP::Request::Common qw(POST);
use HTTP::Status;
use LWP::UserAgent;

my $UPLOAD_URI = $ENV{CPAN_UPLOADER_UPLOAD_URI}
              || 'https://pause.perl.org/pause/authenquery?ACTION=add_uri';

#pod =method upload_file
#pod
#pod   CPAN::Uploader->upload_file($file, \%arg);
#pod
#pod   $uploader->upload_file($file);
#pod
#pod Valid arguments are:
#pod
#pod   user        - (required) your CPAN / PAUSE id
#pod   password    - (required) your CPAN / PAUSE password
#pod   subdir      - the directory (under your home directory) to upload to
#pod   http_proxy  - uri of the http proxy to use
#pod   upload_uri  - uri of the upload handler; usually the default (PAUSE) is right
#pod   debug       - if set to true, spew lots more debugging output
#pod   retries     - number of retries to perform on upload failure (5xx response)
#pod   retry_delay - number of seconds to wait between retries
#pod
#pod This method attempts to actually upload the named file to the CPAN.  It will
#pod raise an exception on error. C<upload_uri> can also be set through the ENV
#pod variable C<CPAN_UPLOADER_UPLOAD_URI>.
#pod
#pod =cut

sub upload_file {
  my ($self, $file, $arg) = @_;

  Carp::confess(q{don't supply %arg when calling upload_file on an object})
    if $arg and ref $self;

  Carp::confess(q{attempted to upload a non-file}) unless -f $file;

  # class call with no args is no good
  Carp::confess(q{need to supply %arg when calling upload_file from the class})
    if not (ref $self) and not $arg;

  $self = $self->new($arg) if $arg;

  if ($arg->{dry_run}) {
    require Data::Dumper;
    $self->log("By request, cowardly refusing to do anything at all.");
    $self->log(
      "The following arguments would have been used to upload: \n"
      . '$self: ' . Data::Dumper::Dumper($self)
      . '$file: ' . Data::Dumper::Dumper($file)
    );
  } else {
    my $retries = $self->{retries} || 0;
    my $tries = ($retries > 0) ? $retries + 1 : 1;

    TRY: for my $try (1 .. $tries) {
      last TRY if eval { $self->_upload($file); 1 };
      die $@ unless $@ !~ /request failed with error code 5/;

      if ($try <= $tries) {