#!/apps/perl5/bin/perl -w
#
# cpan-upload - upload one or more file to CPAN (via PAUSE)
#
# $Id: cpan-upload,v 1.8 2001/03/06 17:17:52 neilb Exp $
#

use strict;
use vars qw($VERSION);

use AppConfig::Std;
use Net::FTP;
use HTTP::Request::Common qw(POST);
use LWP::UserAgent;
use HTTP::Status;
use File::Basename;

$VERSION = sprintf("%d.%d", q$Revision: 1.8 $ =~ /(\d+)\.(\d+)/);


#-----------------------------------------------------------------------
#       Configuration constants and globals
#-----------------------------------------------------------------------
my $PROGRAM;
my $SITE          = 'pause.kbx.de';
my $UPLOAD_DIR    = 'incoming';
my $PAUSE_ADD_URI = 'http://pause.kbx.de/pause/authenquery';
my $config;

#-----------------------------------------------------------------------
#       MAIN BODY
#-----------------------------------------------------------------------

initialise();

ftp_upload_files(@ARGV);
pause_add_files(@ARGV);
_verbose(int(@ARGV), int(@ARGV) == 1 ? " file " : " files ",
         "uploaded successfuly.\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;


    #-------------------------------------------------------------------
    # Turn off buffering on STDOUT
    #-------------------------------------------------------------------
    ($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('password', { EXPAND   => 0 });
    $config->define('mailto');
    $config->define('ftp_gateway');
    $config->define('ftp_proxy');
    $config->define('http_proxy');

    #-------------------------------------------------------------------
    # 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 email address (mailto) specified\n" unless $config->mailto;
    die "No PAUSE user specified\n"             unless $config->user;
    die "No password specified\n"               unless $config->password;

    die "No files specified for upload\n" unless @ARGV > 0;

    $config->verbose(1) if $config->debug && !$config->verbose;

    #-------------------------------------------------------------------
    # Display banner at the start of the run
    #-------------------------------------------------------------------
    _verbose("$PROGRAM v$VERSION\n");
}

#=======================================================================
# ftp_upload_files() - upload the one or more files to PAUSE ftp server
#=======================================================================
sub ftp_upload_files
{
    my @files = @_;

    my $ftp;                      # Net::FTP instance
    my @new_args;                 # arg list to pass to constructor
    my ($user, $password);        # user and password for login method
    my $file;


    _verbose("Using FTP to upload files to PAUSE\n");

    #-------------------------------------------------------------------
    # Make the connection to the PAUSE ftp server:
    # First we determine how we're going to make the connection ...
    #-------------------------------------------------------------------
    if ($config->ftp_gateway)
    {
        _debug("  establishing connection via an FTP gateway\n");
        @new_args = ($config->ftp_gateway);
	($user, $password) = ("ftp\@$SITE", $config->mailto);
    }
    else
    {
        ($user, $password) = ('ftp', $config->mailto);
        @new_args = ($SITE);
	if ($config->ftp_proxy)
	{
	    _debug("  establishing connection via proxy",
                     $config->ftp_proxy, "\n");
            push(@new_args, 'Firewall' => $config->ftp_proxy);
	}
	else
	{
	    _debug("  establishing connection\n");
	}
    }

    #-------------------------------------------------------------------
    # ... and then we actually make the connection and log in
    #-------------------------------------------------------------------
    if (not defined($ftp = Net::FTP->new(@new_args)))
    {
        die "failed to connect to remote server: $!\n";
    }
    if (!$ftp->login($user, $password))
    {
        $ftp->quit();
        die "    failed to login as user 'ftp', password $password - ",
            $ftp->message(), "[", $ftp->code(), "]\n";
    }

    #-------------------------------------------------------------------
    # Change to the right directory, and set binary mode
    #-------------------------------------------------------------------
    _debug("  changing to \"$UPLOAD_DIR\" directory...\n");
    if (!$ftp->cwd($UPLOAD_DIR))
    {
        $ftp->quit();
	die "failed to change directory to $UPLOAD_DIR!\n";
    }

    _debug("  setting binary mode.\n");
    if (not $ftp->binary())
    {
        $ftp->quit();
        die "  failed to change type to 'binary' - ", $ftp->message(),
            "[", $ftp->code(), "]\n";
    }

    #-------------------------------------------------------------------
    # Put the file(s)
    #-------------------------------------------------------------------
    foreach $file (@files)
    {
        _verbose("  uploading file \"$file\"\n");
        $ftp->put($file)
            || warn "    failed to upload - ", $ftp->message(), "\n";
    }

    #-------------------------------------------------------------------
    # Close the connection with the server.
    #-------------------------------------------------------------------
    _debug("  closing connection with FTP server\n");
    $ftp->quit;
}

#=======================================================================
#
# 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;


    _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);

        #---------------------------------------------------------------
        # Create the request to add the file
        #---------------------------------------------------------------
        $request = POST($PAUSE_ADD_URI,
                    {
                     HIDDENNAME => $config->user(),
                     pause99_add_uri_upload => $basename,
                     SUBMIT_pause99_add_uri_upload => " Upload the checked file "
                    });
        $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("\nLooks 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 verbose mode.
#
#=======================================================================
sub _debug
{
    return unless $config->debug;
    print join('', @_);
}


__END__

#-----------------------------------------------------------------------

=head1 NAME

cpan-upload - upload one or more files to CPAN, using PAUSE

=head1 SYNOPSIS

B<cpan-upload> [options] I<file1> .. I<fileN>

=head1 DESCRIPTION

B<cpan-upload> is a script which automates the process of uploading
a file to CPAN using PAUSE, the Perl Authors Upload SErver:

=over 4

=item *

FTP the file(s) to the PAUSE ftp server, B<put>ting them
in the incoming directory.

=item *

Register the upload(s) 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 (ses SEE ALSO section below).

Before using this script 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. If not, you can probably
just use the command-line options, as described below.

For example, to upload a recent version of the Net::Dict module
I ran:

    % cpan-upload Net-Dict-1.04.tar.gz

If everything went OK, you'll get a mail message from the PAUSE monitor.

=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 -ftp_gateway <host>

Specifies the name of the host which has your ftp gateway.

=item -ftp_proxy <host>

Specifies the name of the host which has your ftp proxy,
if you're behind a firewall. 

=item -http_proxy <URL>

Specifies the URL for a proxy to use when making HTTP requests.

=item -mailto <email>

Your email address, to include the HTTP request header.
This is also used as the password for the ftp upload to PAUSE.

=item -help

Displays a short help message with the OPTIONS section
from the cpan-upload documentation.

=item -doc

Display the full documentation for B<cpan-upload>.

=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> 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 user <username>

This is used to specify your PAUSE username.
This just saves you from typing it every time you run the script.

=item password <password>

This is used to specify your PAUSE password.


=item ftp_proxy <HOST>

Specifies the hostname of your ftp gateway used to get through
a firewall. For example:

    ftp_proxy = ftp-gw

=item http_proxy <URL>

The URL for the proxy to use when making HTTP requests to the PAUSE
web server. For example:

    http_proxy = http://proxy/

=item mailto <EMAIL>

Specifies the email address which is passed in the header of
the HTTP request, and as the password for the anonymous ftp upload.
You must provide this.

=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      = neilb@cre.canon.co.uk
    ftp_proxy   = ftp-gw
    http_proxy  = http://proxy.cre.canon.co.uk/

Note that your .pause must not be readable by others,
since it can contain your PAUSE password. The b<cpan-upload> script
refuses to run if your config file can be read by others.

=cut

=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 Net::FTP

Graham Barr's studly module for doing that crazy ftp thang.
Part of the libnet distribution, available from:

    http://www.cpan.org/modules/by-module/Net/

=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.
This is actually a subclass of C<AppConfig>, which you'll also need.

    http://www.cpan.org/modules/by-module/AppConfig/

=back

=head1 VERSION

$Id: cpan-upload,v 1.8 2001/03/06 17:17:52 neilb Exp $

=head1 AUTHOR

Neil Bowers E<lt>neilb@cre.canon.co.ukE<gt>

=head1 COPYRIGHT

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

