CPAN::Uploader - upload things to the CPAN

  CPAN::Uploader->upload_file($file, \%arg);

  $uploader->upload_file($file);

  user       - (required) your CPAN / PAUSE id
  password   - (required) your CPAN / PAUSE password
  subdir     - the directory (under your home directory) to upload to
  http_proxy - uri of the http proxy to use
  upload_uri - uri of the upload handler; usually the default (PAUSE) is right
  debug      - if set to true, spew lots more debugging output

  my $uploader = CPAN::Uploader->new(\%arg);

  my $config = CPAN::Uploader->read_config_file( $filename );

  $uploader->log($message);

use strict;
use warnings;
package CPAN::Uploader;
BEGIN {
  $CPAN::Uploader::VERSION = '0.103000';
}
# ABSTRACT: upload things to the CPAN


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}
              || 'http://pause.perl.org/pause/authenquery';


use Data::Dumper;
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;

  # 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}) {
    $self->log("By request, cowardly refusing to do anything at all.");
    $self->log(
      "The following arguments would have been used to upload: \n"
      . '$self: ' . Dumper($self)
      . '$file: ' . Dumper($file)
    );
  } else {
    $self->_upload($file);
  }
}

sub _ua_string {
  my ($self) = @_;
  my $class   = ref $self || $self;
  my $version = $class->VERSION;

  return "$class/$version";
}

sub _upload {
  my $self = shift;
  my $file = shift;

  $self->log("registering upload with PAUSE web server");

  my $agent = LWP::UserAgent->new;
  $agent->agent( $self->_ua_string );

  $agent->env_proxy;
  $agent->proxy(http => $self->{http_proxy}) if $self->{http_proxy};

  my $uri = $self->{upload_uri} || $UPLOAD_URI;

  my $request = POST(
    $uri,
    Content_Type => 'form-data',
    Content      => {
      HIDDENNAME                        => $self->{user},
      CAN_MULTIPART                     => 1,
      pause99_add_uri_upload            => File::Basename::basename($file),
      SUBMIT_pause99_add_uri_httpupload => " Upload this file from my disk ",
      pause99_add_uri_uri               => "",
      pause99_add_uri_httpupload        => [ $file ],
      ($self->{subdir} ? (pause99_add_uri_subdirtext => $self->{subdir}) : ()),
    },
  );

  $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");
  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 PAUSE web server)\n",
        "It used to be: ", $UPLOAD_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("PAUSE add message sent ok [" . $response->code . "]");
  }
}



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

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


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

  unless ($filename) {
    my $home  = $ENV{HOME} || '.';
    $filename = File::Spec->catfile($home, '.pause');

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

  # Process .pause
  open my $pauserc, '<', $filename
    or die "can't open $filename for reading: $!";

  my %from_file;
  while (<$pauserc>) {
    chomp;
    next unless $_ and $_ !~ /^\s*#/;

    my ($k, $v) = /^\s*(\w+)\s+(.+)$/;
    Carp::croak "multiple enties for $k" if $from_file{$k};
    $from_file{$k} = $v;
  }

  return \%from_file;
}


sub log {
  shift;
  print "$_[0]\n"
}


sub log_debug {
  my $self = shift;
  return unless $self->{debug};
  $self->log($_[0]);
}

1;

__END__