#!/usr/bin/perl -w
#
# cpan-upload-http - upload one or more file to CPAN (via PAUSE)
#
use strict;
use vars qw($VERSION);
use AppConfig::Std;
use HTTP::Request::Common qw(POST);
use LWP::UserAgent;
use HTTP::Status;
use File::Basename;
$VERSION = "2.4";
#-----------------------------------------------------------------------
# Configuration constants and globals
#-----------------------------------------------------------------------
my $PROGRAM;
my $SITE = 'pause.perl.org';
my $PAUSE_ADD_URI = 'http://pause.perl.org/pause/authenquery';
my $config;
#-----------------------------------------------------------------------
# MAIN BODY
#-----------------------------------------------------------------------
initialise();
pause_add_files(@ARGV);
_verbose(int(@ARGV), int(@ARGV) == 1 ? " file " : " files ",
"uploaded successfully.\n");
exit 0;
#=======================================================================
#
# initialise()
#
# Create AppConfig instance, parse config file if there is one,
# and command-line options.
#
#=======================================================================
sub initialise
{
my $config_file;
my $HOME;
my $password;
#-------------------------------------------------------------------
# Turn off buffering on STDOUT
#-------------------------------------------------------------------
$| = 1;
($PROGRAM = $0) =~ s!^.*/!!;
#-------------------------------------------------------------------
# Create an AppConfig::Std object, and define our interface
# The EXPAND flag on password tells AppConfig not to try and
# expand any embedded variables - eg if you have a $ sign
# in your password.
#-------------------------------------------------------------------
$HOME = $ENV{'HOME'} || (getpwuid($<))[7];
$config_file = "$HOME/.pause";
if (-e $config_file && ((stat($config_file))[2] & 36) != 0)
{
die "$PROGRAM: your config file $config_file is readable by others!\n";
}
$config = AppConfig::Std->new();
$config->define('user');
$config->define('directory', {ARGCOUNT => 1, ALIAS => 'dir'});
$config->define('password', { EXPAND => 0 });
$config->define('mailto');
$config->define('http_proxy');
$config->define('non_interactive', { ALIAS => 'ni', ARGCOUNT => 0 });
#-------------------------------------------------------------------
# Read the user's config file, if they have one,
# then parse the command-line.
#-------------------------------------------------------------------
if (-f $config_file)
{
$config->file($config_file) || exit 1;
}
$config->args(\@ARGV)
|| die "run \"$PROGRAM -help\" to see valid options\n";
#-------------------------------------------------------------------
# Check we have the information we need
#-------------------------------------------------------------------
die "No files specified for upload\n" unless @ARGV > 0;
die "No email address (mailto) specified\n" unless $config->mailto;
die "No PAUSE user specified\n" unless $config->user;
if (not $config->password)
{
if ($config->non_interactive)
{
die "No password specified\n";
}
else
{
require Term::ReadKey;
$| = 1;
print "Password: ";
Term::ReadKey::ReadMode('noecho');
chop($password = <STDIN>);
Term::ReadKey::ReadMode('restore');
$config->set('password' => $password);
print "\n";
}
}
$config->verbose(1) if $config->debug && !$config->verbose;
#-------------------------------------------------------------------
# Display banner at the start of the run
#-------------------------------------------------------------------
_verbose("$PROGRAM v$VERSION\n");
}
#=======================================================================
#
# pause_add_files()
#
# make an HTTP request to the add_uri form
#
#=======================================================================
sub pause_add_files
{
my @files = @_;
my $file;
my $basename;
my $request;
my $response;
my $agent;
my $argref;
_verbose("registering upload with PAUSE web server\n");
#-------------------------------------------------------------------
# Create the agent we'll use to make the web requests
#-------------------------------------------------------------------
_debug(" creating instance of LWP::UserAgent\n");
$agent = LWP::UserAgent->new() || die "Failed to create UserAgent: $!\n";
$agent->agent("$PROGRAM/$VERSION");
$agent->from($config->mailto);
if (defined $config->http_proxy)
{
$agent->proxy(['http'], $config->http_proxy);
}
#-------------------------------------------------------------------
# Post an upload message to the PAUSE web site for each file
#-------------------------------------------------------------------
foreach $file (@files)
{
$basename = basename($file);
open(my $fh, $file) or die "Failed to open $file: $!";
my $contents = do { local $/; <$fh> };
close($fh);
#---------------------------------------------------------------
# Create the request to add the file
#---------------------------------------------------------------
$argref = {
HIDDENNAME => $config->user(),
CAN_MULTIPART => 1,
pause99_add_uri_upload => $basename,
SUBMIT_pause99_add_uri_httpupload => " Upload this file from my disk ",
pause99_add_uri_uri => "",
pause99_add_uri_httpupload => [ $file ],
};
if ($config->directory)
{
$argref->{'pause99_add_uri_subdirtext'} = $config->directory;
}
$request = POST($PAUSE_ADD_URI,
Content_Type => 'form-data',
Content => $argref);
$request->authorization_basic($config->user, $config->password);
_debug("----- REQUEST BEGIN -----\n",
$request->as_string(),
"----- REQUEST END -------\n");
#---------------------------------------------------------------
# Make the request to the PAUSE web server
#---------------------------------------------------------------
_verbose(" POSTing upload for $file\n");
$response = $agent->request($request);
#---------------------------------------------------------------
# So, how'd we do?
#---------------------------------------------------------------
if (not defined $response)
{
die "Request completely failed - we got undef back: $!\n";
}
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:\n\n\t", $PAUSE_ADD_URI, "\n\n",
"Please inform the maintainer of this script\n";
}
else
{
die "request failed\n Error code: ", $response->code,
"\n Message: ", $response->message, "\n";
}
}
else
{
_debug("Looks OK!\n",
"----- RESPONSE BEGIN -----\n",
$response->as_string(),
"----- RESPONSE END -------\n");
_verbose(" PAUSE add message sent ok [",
$response->code, "]\n");
}
}
}
#=======================================================================
#
# _verbose()
#
# displays the message strings passed if in verbose mode.
#
#=======================================================================
sub _verbose
{
return unless $config->verbose;
print join('', @_);
}
#=======================================================================
#
# _debug()
#
# displays the message strings passed if in debug mode.
#
#=======================================================================
sub _debug
{
return unless $config->debug;
print join('', @_);
}
__END__
#-----------------------------------------------------------------------
=head1 NAME
cpan-upload-http - upload one or more files to CPAN, using PAUSE
=head1 SYNOPSIS
B<cpan-upload-http> [OPTIONS] I<file1> .. I<fileN>
=head1 DESCRIPTION
B<cpan-upload-http> is a script which automates the process of uploading
a file to CPAN using PAUSE, the Perl Authors Upload Server.
For example, to upload a recent version of the Net::Dict module
I ran:
% cpan-upload-http -verbose Net-Dict-1.07.tar.gz
If everything went OK, you'll get two mail messages from the PAUSE monitor:
one to acknowledge the upload,
and one to let you know if your upload made it through to CPAN.
Given one or more files to upload, cpan-upload-http carries
out the following two steps:
=over 4
=item *
HTTP file upload and register the module by POSTing to the PAUSE web server.
=back
This is just one of the ways you can upload something to PAUSE.
See the PAUSE FAQ for details (referenced in SEE ALSO section below).
Before using cpan-upload-http you must register with PAUSE,
to get a username and password.
If you are a regular uploader to PAUSE, you'll probably want to
create a C<.pause> configuration file,
as described in L<"CONFIGURATION FILE"> below.
If not, you can just use the command-line options,
as described in L<"OPTIONS"> below.
If you don't provide your password (via configuration file or
command-line), then you will be prompted for it.
Echo'ing will be turned off while you type your password.
This behaviour can be suppressed with the B<-non_interactive>
option, described below.
=head1 OPTIONS
=over 4
=item -user <string>
Your PAUSE username (which you previously registered with PAUSE).
=item -password <string>
The password for your PAUSE username.
=item -directory <string> | -dir <string>
A subdirectory in your CPAN area where the file should be uploaded to.
=item -mailto <email>
Your email address to include the HTTP request header.
=item -http_proxy <URL>
Specifies the URL for a proxy to use when making HTTP requests.
=item -non_interactive | -ni
cpan-upload-http should not prompt for any missing information (eg password),
it should just warn or die, as appropriate.
=item -help
Displays a short help message with the OPTIONS section
from the cpan-upload-http documentation.
=item -doc
Display the full documentation for B<cpan-upload-http>.
=item -verbose
Turns on verbose information as the script runs.
=item -debug
Turns on debugging information. Useful mainly for the developer,
it displays the HTTP request and response.
=item -version
Display the version number of the B<cpan-upload-http> script.
=back
=head1 CONFIGURATION FILE
You can provide the configuration information needed
via a .pause file in your home directory.
If you upload files at all regularly you will want to
set up one of these.
=over 4
=item B<user> I<username>
This is used to specify your PAUSE username.
This just saves you from typing it every time you run the script.
=item B<password> I<password>
This is used to specify your PAUSE password.
=item B<directory> I<path>
Specify a subdirectory in your CPAN area.
=item B<http_proxy> I<URL>
The URL for the proxy to use when making HTTP requests to the PAUSE
web server. For example:
http_proxy = http://proxy/
=item B<mailto> I<EMAIL>
Specifies the email address which is passed in the header of
the HTTP request.
You must provide this.
=item B<non_interactive>
Specifies that cpan-upload-http should never prompt the user (eg for password),
but should take a default action.
=back
The following is a sample .pause file:
# example .pause for user neilb
# the user is your registered PAUSE username
user NEILB
password thisisnotmyrealpassword
mailto = neil@bowers.com
http_proxy = http://proxy.cre.canon.co.uk/
non_interactive
Note that your .pause must not be readable by others,
since it can contain your PAUSE password. The B<cpan-upload-http> script
refuses to run if your config file can be read by others.
=cut
=head1 POSSIBLE TODO ITEMS
Also, let me know if you ever have occasion to wish that the features below
had been implemented. I probably won't do them unless someone
would like to see them in.
I'd be happy to hear any more suggestions.
=over 4
=item *
As with the password, prompt for PAUSE username and email address
if not provided (by .pause file or on the command-line).
=item *
Add configuration options for specifying the URI we POST to.
This would let you deal with any changes without requiring a new release.
These aren't likely to change on any regular basis, so seem gratuitous.
=back
=head1 SEE ALSO
=over 4
=item www.cpan.org
The home page for the Comprehensive Perl Archive Network.
=item PAUSE
The Perl Authors Upload SErver. The PAUSE FAQ can be seen on CPAN:
http://www.cpan.org/modules/04pause.html
=item libwww-perl5
The LWP distribution which provides the modules used by this script
to talk to the PAUSE web server. You can get the latest version from:
http://www.cpan.org/modules/by-module/LWP/
=item AppConfig::Std
The module used to handle command-line options and the configuration file.
http://www.cpan.org/authors/id/NEILB/
This is actually a subclass of C<AppConfig>, which you'll also need.
http://www.cpan.org/authors/id/ABW/
=item Term::ReadKey
The module used to turn off echo'ing if we prompt the user
for a PAUSE password.
=back
=head1 VERSION
$Revision: 2.2 $
=head1 SCRIPT CATEGORIES
CPAN
=head1 PREREQUISITES
AppConfig::Std
HTTP::Request::Common
LWP::UserAgent
HTTP::Status
File::Basename
Term::ReadKey
=head1 AUTHOR
Neil Bowers E<lt>neil@bowers.comE<gt>
Brad Fitzpatrick E<lt>brad@danga.comE<gt> -- HTTP upload support, FTP removal.
=head1 COPYRIGHT
Copyright (c) 2001-2002 Neil Bowers.
Copyright (c) 1998-2001 Canon Research Centre Europe. All rights reserved.
This script is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
=cut