Sponsoring The Perl Toolchain Summit 2025: Help make this important event another success Learn more

BDFOY / Module-Release-2.05_07 / lib / Module / Release / PAUSE.pm 

            

              
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

              
package Module::Release::PAUSE;
use strict;
use warnings;
use base qw(Exporter);
use vars qw($VERSION);
our @EXPORT = qw(
        pause_ftp_site should_upload_to_pause pause_claim set_pause_ftp_site
        pause_claim_base_url pause_claim_content pause_claim_content_type
        );
$VERSION = '2.05_07';
=head1 NAME
Module::Release::PAUSE - Interact with the Perl Authors Upload Server (PAUSE)
=head1 SYNOPSIS
The release script automatically loads this module if it thinks that you
want to upload to PAUSE by noticing the C<cpan_user> configuration
directive.
=head1 DESCRIPTION
=over 4
=item set_pause_ftp_site( HOSTNAME )
Set the name of the PAUSE FTP site. If you pass it something that
doesn't look like a host name, it warns and doesn't set anything.
=cut
sub set_pause_ftp_site
        {
        no warnings 'uninitialized';
        unless( $_[1] =~ /^[a-z0-9-]+(\.[a-z0-9-]+)+\z/ )
                {
                $_[0]->_warn( "The argument [$_[0]] does not look like a hostname" );
                return;
                }
        $_[0]->{pause_ftp_site} = $_[1];
        }
=item pause_ftp_site
Return the hostname for PAUSE uploads.
=cut
sub pause_ftp_site
        {
        $_[0]->{pause_ftp_site} || 'pause.perl.org';
        }
=item should_upload_to_pause
Returns true is the object thinks it should upload a distro to PAUSE.
=cut
sub should_upload_to_pause
        {
        no warnings 'uninitialized';
        $_[0]->_debug(    "CPAN user: " . $_[0]->config->cpan_user .
                           " | CPAN pass: " . $_[0]->config->cpan_pass . "\n" );
        $_[0]->config->cpan_user && $_[0]->config->cpan_pass
        }
=item pause_claim
Claim the file in PAUSE
=cut
sub pause_claim
        {
        require HTTP::Request;
        require CACertOrg::CA;
        my $self = shift;
        return unless $self->should_upload_to_pause;
        my $ua  = $self->get_web_user_agent;
        $ua->ssl_opts( verify_hostnames => 1 );
        $ua->ssl_opts( SSL_ca_file => CACertOrg::CA::SSL_ca_file() );
        my $request = HTTP::Request->new( POST => $self->pause_claim_base_url );
        $request->content_type( $self->pause_claim_content_type );
        $request->content( $self->pause_claim_content );
        $request->authorization_basic(
                $self->config->cpan_user, $self->config->cpan_pass );
        my $response = $ua->request( $request );
        $self->_print( "PAUSE upload ",
                $response->as_string =~ /Query succeeded/ ? "successful" : 'failed',
                "\n" );
        }
=item pause_claim_base_url
The base URL to claim something in PAUSE. This is
C<https://pause.perl.org/pause/authenquery>.
XXX: This should read from pause_ftp_site probably
=cut
sub pause_claim_base_url { 'https://pause.perl.org/pause/authenquery' }
=item pause_claim_content
Construct the data for the POST request to claim a file in PAUSE.
=cut
sub pause_claim_content
        {
        require CGI; CGI->import( qw(-oldstyle_urls) );
        my $cgi = CGI->new();
        $cgi->param( 'HIDDENNAME',                     $_[0]->config->cpan_user     );
        $cgi->param( 'CAN_MULTIPART',                  1                            );
        $cgi->param( 'pause99_add_uri_upload',         $_[0]->remote_file           );
        $cgi->param( 'SUBMIT_pause99_add_uri_upload',  'Upload the checked file'    );
        $cgi->param( 'pause99_add_uri_sub',            'pause99_add_uri_subdirtext' );
        $cgi->query_string;
        }
=item pause_claim_content_type
The content type for the POST request to claim a file in PAUSE. This is
C<application/x-www-form-urlencoded>.
=cut
sub pause_claim_content_type { 'application/x-www-form-urlencoded' }
=back
=head1 SEE ALSO
L<Module::Release>
=head1 SOURCE AVAILABILITY
This source is in Github:
        git://github.com/briandfoy/module-release.git
=head1 AUTHOR
brian d foy, C<< <bdfoy@cpan.org> >>
=head1 COPYRIGHT AND LICENSE
Copyright (c) 2007-2011, brian d foy, All Rights Reserved.
You may redistribute this under the same terms as Perl itself.
=cut
1;