view release on metacpan or  search on metacpan

bin/cpanupload  view on Meta::CPAN

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.1 $ =~ /(\d+)\.(\d+)/);


#-----------------------------------------------------------------------
#       Configuration constants and globals
#-----------------------------------------------------------------------
my $PROGRAM;
my $SITE          = 'pause.perl.org';
my $UPLOAD_DIR    = 'incoming';
my $PAUSE_ADD_URI = 'http://pause.perl.org/pause/authenquery';
my $config;
my @uploaded_files;

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

initialise();

@uploaded_files = ftp_upload_files(@ARGV);
pause_add_files(@uploaded_files) if @uploaded_files > 0;
_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('ftp_gateway');
    $config->define('ftp_proxy');
    $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");
}