#!/home/grinnz/projects/cpandoc-browser/perls/5.38.2/bin/perl use strict; use warnings; package cpan_upload; # PODNAME: cpan-upload # ABSTRACT: upload a distribution to the CPAN use CPAN::Uploader; use Getopt::Long::Descriptive 0.084; #pod =head1 USAGE #pod #pod usage: cpan-upload [options] file-to-upload-1 [ file-to-upload-2 ... ] #pod -v --verbose enable verbose logging #pod -h --help display this help message #pod --dry-run do not actually upload anything #pod #pod -u --user your PAUSE username #pod -p --password the password to your PAUSE account #pod -d --directory a dir in your CPAN space in which to put the file #pod --http-proxy URL of the http proxy to use in uploading #pod --ignore-errors instead of aborting, continue to next file on error #pod -c --config config file to use; defaults to ~/.pause #pod --md5 compute MD5 checksums of the files #pod --retries number of retries to perform on upload failure #pod --retry-delay number of seconds to wait between retries #pod #pod =head1 CONFIGURATION #pod #pod If you have a C<.pause> file in your home directory, it will be checked for a #pod username and password. It should look like this: #pod #pod user EXAMPLE #pod password your-secret-password #pod #pod You can GnuPG-encrypt this file if you wish, but you must install #pod L and configure your gpg-agent as L #pod currently doesn't prompt for a password at decryption time: #pod #pod # Follow the prompts, setting your key as the "recipient" #pod # Use ^D once you've finished typing out your authentication information #pod gpg -ea > $HOME/.pause #pod # OR, encrypt a file you already created: #pod gpg -ea $HOME/.pause && mv $HOME/.pause{.asc,} #pod #pod =head1 SEE ALSO #pod #pod =over 4 #pod #pod =item L #pod #pod =item L #pod #pod =back #pod #pod =cut my %arg; # This nonsensical hack is to cope with Module::Install wanting to call # cpan-upload -verbose; it should be made to use CPAN::Uploader instead. $ARGV[0] = '--verbose' if @ARGV == 2 and $ARGV[0] eq '-verbose'; # Process arguments my ($opt, $usage) = describe_options( "usage: %c [options] file-to-upload", [ "verbose|v" => "enable verbose logging" ], [ "help|h" => "display this help message" ], [ "dry-run" => "do not actually upload anything" ], [], [ "user|u=s" => "your PAUSE username" ], [ "password|p=s" => "the password to your PAUSE account" ], [ "directory|d=s" => "a dir in your CPAN space in which to put the files" ], [ "http-proxy=s" => "URL of the http proxy to use in uploading" ], [ "ignore-errors" => "instead of aborting, continue to next file on error" ], [ "config|c=s" => "config file to use; defaults to ~/.pause" ], [ "md5" => "compute MD5 checksums of the files" ], [ "retries=i" => "number of retries to perform on upload failure" ], [ "retry-delay=i" => "number of seconds to wait between retries" ], ); if ($opt->help) { print $usage->text; exit; } my $from_file = CPAN::Uploader->read_config_file($opt->config); die "Please provide at least one file name.\n" . $usage unless @ARGV; $arg{user} = $opt->_specified('user') ? $opt->user : $from_file->{user}; die "Please provide a value for --user\n" unless defined $arg{user}; $arg{user} = uc $arg{user}; $arg{password} = $opt->password if $opt->_specified('password'); if ( ! $arg{password} and defined $from_file->{user} and ($arg{user} eq uc $from_file->{user}) ) { $arg{password} = $from_file->{password}; } $arg{debug} = 1 if $opt->verbose; $arg{subdir} = $opt->directory if defined $opt->directory; $arg{ $_ } = $opt->$_ for grep { defined $opt->$_ } qw(dry_run http_proxy retries retry_delay); if (! $arg{password}) { require Term::ReadKey; local $| = 1; print "PAUSE Password: "; Term::ReadKey::ReadMode('noecho'); $arg{password} = ; chomp $arg{password} if defined $arg{password}; Term::ReadKey::ReadMode('restore'); print "\n"; } my $md5; foreach my $file (@ARGV) { unless (-f $file) { warn "skipping non-file $file\n"; next; } my $ok = eval { CPAN::Uploader->upload_file( $file, \%arg, ); 1; }; if ($ok) { if ($opt->md5) { if ($md5) { $md5->reset; } else { require Digest::MD5; $md5 = Digest::MD5->new; } open my $fh, '<', $file or die "can't open $file for reading: $!"; my $digest = do { local $@; eval { $md5->addfile($fh)->hexdigest; }; }; if (defined $digest) { print "md5: $digest\n"; } } } else { my $error = $@; die $@ unless $opt->ignore_errors; warn $@; } } __END__ =pod =encoding UTF-8 =head1 NAME cpan-upload - upload a distribution to the CPAN =head1 VERSION version 0.103018 =head1 PERL VERSION This library should run on perls released even a long time ago. It should work on any version of perl released in the last five years. Although it may work on older versions of perl, no guarantee is made that the minimum required version will not be increased. The version may be increased for any reason, and there is no promise that patches will be accepted to lower the minimum required perl. =head1 USAGE usage: cpan-upload [options] file-to-upload-1 [ file-to-upload-2 ... ] -v --verbose enable verbose logging -h --help display this help message --dry-run do not actually upload anything -u --user your PAUSE username -p --password the password to your PAUSE account -d --directory a dir in your CPAN space in which to put the file --http-proxy URL of the http proxy to use in uploading --ignore-errors instead of aborting, continue to next file on error -c --config config file to use; defaults to ~/.pause --md5 compute MD5 checksums of the files --retries number of retries to perform on upload failure --retry-delay number of seconds to wait between retries =head1 CONFIGURATION If you have a C<.pause> file in your home directory, it will be checked for a username and password. It should look like this: user EXAMPLE password your-secret-password You can GnuPG-encrypt this file if you wish, but you must install L and configure your gpg-agent as L currently doesn't prompt for a password at decryption time: # Follow the prompts, setting your key as the "recipient" # Use ^D once you've finished typing out your authentication information gpg -ea > $HOME/.pause # OR, encrypt a file you already created: gpg -ea $HOME/.pause && mv $HOME/.pause{.asc,} =head1 SEE ALSO =over 4 =item L =item L =back =head1 AUTHOR Ricardo SIGNES =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2023 by Ricardo SIGNES. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut