File Coverage

blib/lib/MojoX/CPAN/Uploader.pm
Criterion Covered Total %
statement 27 41 65.8
branch 7 16 43.7
condition n/a
subroutine 7 8 87.5
pod 2 2 100.0
total 43 67 64.1


line stmt bran cond sub pod time code
1             package MojoX::CPAN::Uploader;
2              
3 2     2   477321 use warnings;
  2         5  
  2         83  
4 2     2   11 use strict;
  2         4  
  2         97  
5              
6 2     2   15 use Carp;
  2         9  
  2         173  
7 2     2   14 use File::Basename;
  2         3  
  2         156  
8              
9 2     2   543 use Mojo::Base '-base';
  2         8018  
  2         18  
10              
11             require Mojo::UserAgent;
12             require IO::Socket::SSL;
13              
14             has client => sub { Mojo::UserAgent->new };
15             has [qw/user pass/];
16             has url => sub { Mojo::URL->new('https://pause.perl.org/pause/authenquery') };
17             has defaults => sub {
18             { CAN_MULTIPART => 1,
19             SUBMIT_pause99_add_uri_httpupload =>
20             " Upload this file from my disk ",
21             pause99_add_uri_uri => "",
22             };
23             };
24              
25             our $VERSION = '0.033';
26              
27             sub auth {
28 1     1 1 44404 my $self = shift;
29              
30 1 50       5 croak("Basic authorization user name can't contain ':'")
31             if $_[0] =~ /:/;
32              
33 1         24 $self->user(shift);
34 1         21 $self->pass(shift);
35             }
36              
37             sub upload {
38 2     2 1 2423 my ($self, $file, $subdir) = splice @_, 0, 3;
39 2         57 my $url = $self->url->clone->userinfo($self->user . ':' . $self->pass);
40              
41 2 50       430 croak "Auth info required!" unless $self->user;
42              
43 2         58 my $tx = $self->client->post(
44             $url, form => {
45 2 100       55 %{$self->defaults},
46             HIDDENNAME => $self->user,
47             pause99_add_uri_upload => basename($file),
48             pause99_add_uri_httpupload => {file => $file},
49             ($subdir ? (pause99_add_uri_subdirtext => $subdir) : ()),
50             },
51             @_
52             );
53              
54 2 50       260732 return 1 if $tx->res->code == 200;
55              
56 2 50       136 if ($tx->res->code == 406) {
    50          
57 0         0 my $reason = $tx->res->dom->at('blockquote.actionresponse');
58 0         0 my $title = $reason->at('h3');
59 0 0       0 $title = $title ? $title->all_text : 'unknown';
60 0         0 my @p;
61 0         0 my $table = 0;
62             $reason->find('p')->each(
63             sub {
64 0 0   0   0 return $table = 1 if $_[0]->at('table');
65 0         0 my $t = shift->all_text;
66 0         0 $t =~ s/^\s+|\s$//g;
67 0         0 $t =~ s/[\n\r]/ /g;
68 0         0 $t =~ s/\s{2,}/ /g;
69 0         0 push @p, $t;
70             }
71 0         0 );
72              
73 0         0 return Mojo::Exception->new(
74             "Error '$title' " . $tx->res->code . "\n" . join("\n", @p, ''));
75              
76             }
77             elsif ($tx->res->code == 401) {
78 0         0 return Mojo::Exception->new(
79             "Wrong login/password for Perl Author '" . $self->user . "'");
80             }
81              
82 2         233 return Mojo::Exception->new("Unknown error: " . $tx->res->code);
83             }
84              
85             1;
86             __END__