package Module::Release::WebUpload::Mojo;

use strict;
use warnings;
use Exporter qw(import);
use vars qw($VERSION);

use Carp qw(croak);
use Mojo::UserAgent;
use File::Basename qw(basename);

our @EXPORT = qw(
	web_upload
	make_agent
	default_web_hostname
	pause_add_uri
	);

$VERSION = '2.122';

=encoding utf8

=head1 NAME

Module::Release::WebUpload::Mojo - Upload through the PAUSE web interface

=head1 SYNOPSIS

The release script automatically loads this module when it's time
to upload a file. It's implemented with C<Mojo::UserAgent>.

=head1 DESCRIPTION

=over 4

=item web_upload( PARAMS )

Upload the file to PAUSE

=cut

sub web_upload {
	my $self = shift;

	my $ua = $self->make_agent;

	$self->_debug( sprintf "Uploading file %s", $self->local_file );

	my $params = {
		HIDDENNAME                    => $self->config->cpan_user,
		CAN_MULTIPART                 => 1,
		pause99_add_uri_subdirtext    => '',
		SUBMIT_pause99_add_uri_httpupload => ' Upload this file from my disk ',
		pause99_add_uri_httpupload    => { file => $self->local_file },
		};

	$self->_print( "File uploading\n" );
	my $tx = $ua->post(
		$self->pause_add_uri(
		 	$self->config->cpan_user,
		 	$self->config->cpan_pass,
		 	),
		 form => $params,
		 );

	if( my $res = $tx->success ) {
		$self->_print( "File uploaded\n" );
		return 1;
		}
	else {
		my $err = $tx->error;
		$self->_print( "$err->{code} response: $err->{message}" ) if $err->{code};
		$self->_print( "Connection error: $err->{message}" );
		return 0;
		}
	}

sub make_agent {
	my( $self ) = @_;
	my $agent = Mojo::UserAgent->new;
	$agent->transactor->name( 'release' );
	$agent->http_proxy( $self->config->http_proxy ) if $self->config->http_proxy;
	$agent->https_proxy( $self->config->https_proxy ) if $self->config->https_proxy;

	return $agent;
	}

# XXX: Until I can upgrade OpenSSL
BEGIN {
use Mojo::IOLoop::Client;

use constant TLS => $ENV{MOJO_NO_TLS}
  ? 0
  : eval 'use IO::Socket::SSL 1.94 (); 1';

no warnings 'redefine';
sub Mojo::IOLoop::Client::_try_tls {
  my ($self, $args) = @_;

  my $handle = $self->{handle};
  return $self->_cleanup->emit(connect => $handle) unless $args->{tls};
  return $self->emit(error => 'IO::Socket::SSL 1.94+ required for TLS support')
    unless TLS;

  # Upgrade
  weaken $self;
  my %options = (
    SSL_ca_file => $args->{tls_ca}
      && -T $args->{tls_ca} ? $args->{tls_ca} : undef,
    SSL_cert_file  => $args->{tls_cert},
    SSL_error_trap => sub { $self->emit(error => $_[1]) },
    SSL_hostname   => IO::Socket::SSL->can_client_sni ? $args->{address} : '',
    SSL_key_file   => $args->{tls_key},
    SSL_startHandshake  => 0,
    SSL_verify_mode     => 0x00,  # XXX turn off hostname verification
    SSL_verifycn_name   => $args->{address},
    SSL_verifycn_scheme => $args->{tls_ca} ? 'http' : undef
  );

  my $reactor = $self->reactor;
  $reactor->remove($handle);
  return $self->emit(error => 'TLS upgrade failed')
    unless IO::Socket::SSL->start_SSL($handle, %options);
  $reactor->io($handle => sub { $self->_tls })->watch($handle, 0, 1);
}
}

=back

=head2 Default values

Override these methods to change the default values. Remember that
the overridden methods have to show up in the C<Module::Release>
namespace.

=over 4

=item default_web_hostname

pause.perl.org

=item pause_add_uri

http://pause.perl.org/pause/authenquery

=cut

sub default_web_hostname   { "pause.perl.org" }
sub pause_add_uri          {
	my( $self, $user, $pass ) = @_;
	sprintf 'https://%s:%s@pause.perl.org/pause/authenquery', $user, $pass;
	};

=back

=head1 SEE ALSO

L<Module::Release>

=head1 SOURCE AVAILABILITY

This source is in Github:

	https://github.com/briandfoy/module-release

=head1 AUTHOR

brian d foy, C<< <bdfoy@cpan.org> >>

=head1 COPYRIGHT AND LICENSE

Copyright © 2007-2016, brian d foy <bdfoy@cpan.org>. All rights reserved.

You may redistribute this under the same terms as Perl itself.

=cut

1;