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
|
use strict;
use warnings;
use Test::More 0.88 tests => 16;
use lib 't/lib';
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 $chrome = shift->chrome;
$chrome->set_response_for('PAUSE username: ', shift);
$chrome->set_response_for('PAUSE password: ', shift);
}
#---------------------------------------------------------------------
# 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/You need to supply a username/,
"release without credentials fails");
my $msgs = $tzil->log_messages;
ok(grep({ /You need to supply a username/} @$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/You need to supply a password/,
"release without password fails");
my $msgs = $tzil->log_messages;
ok(grep({ /You need to supply a password/} @$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"
);
}
|
