File: cpan-upload

package info (click to toggle)
libcpan-uploader-perl 0.103018-1
  • links: PTS, VCS
  • area: main
  • in suites: bookworm, forky, sid, trixie
  • size: 184 kB
  • sloc: perl: 425; makefile: 2
file content (247 lines) | stat: -rw-r--r-- 7,209 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
#!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<Config::Identity> and configure your gpg-agent as L<Config::Identity>
#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<CPAN::Uploader>
#pod
#pod =item L<Config::Identity>
#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} = <STDIN>;
  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<Config::Identity> and configure your gpg-agent as L<Config::Identity>
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<CPAN::Uploader>

=item L<Config::Identity>

=back

=head1 AUTHOR

Ricardo SIGNES <cpan@semiotic.systems>

=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