Alt-CPAN-Uploader-tinyua
view release on metacpan - search on metacpan
view release on metacpan or search on metacpan
lib/CPAN/Uploader.pm view on Meta::CPAN
$uri->userinfo(join ':', $self->{user}, $self->{password});
# Make the request to the PAUSE web server
$self->log("POSTing upload for $file to $uri");
my $response = $agent->post_multipart($uri, {
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 => {
filename => $file,
content => do {open my $fh, '<', $file; binmode $fh; local $/ = <$fh>},
},
($self->{subdir} ? (pause99_add_uri_subdirtext => $self->{subdir}) : ()),
});
# So, how'd we do?
if (not defined $response) {
die "Request completely failed - we got undef back: $!";
}
if (!$response->success) {
if ($response->status eq '404') {
die $self->target, "'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 @{[__PACKAGE__]}.\n";
} else {
die "request failed with error code ", $response->status,
"\n Message: ", $response->reason, "\n";
}
} else {
$self->log_debug($_) for (
"Looks OK!",
"----- RESPONSE BEGIN -----\n" .
$response->content . "\n" .
"----- RESPONSE END -------\n"
);
$self->log($self->target . " add message sent ok [" . $response->status . "]");
}
}
=method new
my $uploader = CPAN::Uploader->new(\%arg);
This method returns a new uploader. You probably don't need to worry about
this method.
Valid arguments are the same as those to C<upload_file>.
=cut
sub new {
my ($class, $arg) = @_;
$arg->{$_} or Carp::croak("missing $_ argument") for qw(user password);
bless $arg => $class;
}
=method read_config_file
my $config = CPAN::Uploader->read_config_file( $filename );
This reads the config file and returns a hashref of its contents that can be
used as configuration for CPAN::Uploader.
If no filename is given, it looks for F<.pause> in the user's home directory
(from the env var C<HOME>, or the current directory if C<HOME> isn't set).
See L<cpan-upload/CONFIGURATION> for the config format.
=cut
sub read_config_file {
my ($class, $filename) = @_;
unless (defined $filename) {
my $home = File::HomeDir->my_home || '.';
$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
open my $pauserc, '<', $filename
or die "can't open $filename for reading: $!";
while (<$pauserc>) {
chomp;
next unless $_ and $_ !~ /^\s*#/;
my ($k, $v) = /^\s*(\w+)\s+(.+)$/;
Carp::croak "multiple enties for $k" if $conf{$k};
$conf{$k} = $v;
}
}
return \%conf;
}
=method log
$uploader->log($message);
This method logs the given string. The default behavior is to print it to the
screen. The message should not end in a newline, as one will be added as
needed.
=cut
sub log {
shift;
view all matches for this distributionview release on metacpan - search on metacpan
( run in 0.490 second using v1.00-cache-2.02-grep-82fe00e-cpan-1925d2aa809 )