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
|
use strict;
use warnings;
use Test::More 0.88 tests => 17;
use File::Spec ();
use Test::DZil qw(Builder simple_ini);
use Test::Fatal qw(exception);
#---------------------------------------------------------------------
# Install a fake upload_file method for testing purposes:
sub Dist::Zilla::Plugin::UploadToCPAN::_Uploader::upload_file {
my ($self, $archive) = @_;
$self->log("PAUSE $_ is $self->{$_}") for qw(user password);
$self->log("Uploading $archive") if -f $archive;
}
#---------------------------------------------------------------------
# Create a Builder with a simple configuration:
sub build_tzil {
Builder->from_config(
{ dist_root => 'corpus/dist/DZT' },
{
add_files => {
'source/dist.ini' => simple_ini('GatherDir', @_),
},
},
);
}
#---------------------------------------------------------------------
# Set responses for the username and password prompts:
sub set_responses {
my ($zilla, $username, $pw) = @_;
$zilla->chrome->set_response_for('PAUSE username: ', $username);
$zilla->chrome->set_response_for("PAUSE password for $username: ", $pw);
}
#---------------------------------------------------------------------
# Pass invalid upload_uri to UploadToCPAN as an extra precaution,
# and don't let it look for ~/.pause:
my %safety_first = (qw(upload_uri http://bogus.example.com/do/not/upload/),
pause_cfg_file => File::Spec->devnull);
#---------------------------------------------------------------------
# config from %PAUSE stash in dist.ini:
{
my $tzil = build_tzil(
[ UploadToCPAN => { %safety_first } ],
'FakeRelease',
[ '%PAUSE' => {qw(
username user
password password
)}],
);
$tzil->release;
my $msgs = $tzil->log_messages;
ok(grep({ /PAUSE user is user/ } @$msgs), "read username");
ok(grep({ /PAUSE password is password/ } @$msgs), "read password");
ok(grep({ /Uploading.*DZT-Sample/ } @$msgs), "uploaded archive");
ok(
grep({ /fake release happen/i } @$msgs),
"releasing continues after upload",
);
}
#---------------------------------------------------------------------
# Config from user input:
{
my $tzil = build_tzil(
[ UploadToCPAN => { %safety_first } ],
'FakeRelease',
);
set_responses($tzil, qw(user password));
$tzil->release;
my $msgs = $tzil->log_messages;
ok(grep({ /PAUSE user is user/ } @$msgs), "entered username");
ok(grep({ /PAUSE password is password/ } @$msgs), "entered password");
ok(grep({ /Uploading.*DZT-Sample/ } @$msgs), "uploaded archive manually");
ok(
grep({ /fake release happen/i } @$msgs),
"releasing continues after manual upload",
);
}
#---------------------------------------------------------------------
# No config at all:
{
my $tzil = build_tzil(
'FakeRelease',
[ UploadToCPAN => { %safety_first } ],
);
# Pretend user just hits Enter at the prompts:
set_responses($tzil, '', '');
like( exception { $tzil->release },
qr/No username was provided/,
"release without credentials fails");
my $msgs = $tzil->log_messages;
ok(grep({ /No username was provided/} @$msgs), "insist on username");
ok(!grep({ /Uploading.*DZT-Sample/ } @$msgs), "no upload without credentials");
ok(
!grep({ /fake release happen/i } @$msgs),
"no release without credentials"
);
}
#---------------------------------------------------------------------
# No config at all, but enter username:
{
my $tzil = build_tzil(
'FakeRelease',
[ UploadToCPAN => { %safety_first } ],
);
# Pretend user just hits Enter at the password prompt:
set_responses($tzil, 'user', '');
like( exception { $tzil->release },
qr/No password was provided/,
"release without password fails");
my $msgs = $tzil->log_messages;
ok(grep({ /No password was provided/} @$msgs), "insist on password");
ok(!grep({ /Uploading.*DZT-Sample/ } @$msgs), "no upload without password");
ok(
!grep({ /fake release happen/i } @$msgs),
"no release without password"
);
}
# Config from dist.ini
{
my $tzil = build_tzil(
'FakeRelease',
[ UploadToCPAN => {
%safety_first,
username => 'me',
password => 'ohhai',
}
],
);
like( exception { $tzil->release },
qr/Couldn't figure out password/,
"password set in dist.ini is ignored");
}
|
