Newer Older
105 lines | 2.741kb
add files
Yuki Kimoto authored on 2014-03-26
1
package Mojolicious::Command::cpanify;
2
use Mojo::Base 'Mojolicious::Command';
3

            
4
use File::Basename 'basename';
5
use Getopt::Long qw(GetOptionsFromArray :config no_auto_abbrev no_ignore_case);
6
use Mojo::UserAgent;
7

            
8
has description => "Upload distribution to CPAN.\n";
9
has usage       => <<EOF;
10
usage: $0 cpanify [OPTIONS] [FILE]
11

            
12
  mojo cpanify -u sri -p secr3t Mojolicious-Plugin-MyPlugin-0.01.tar.gz
13

            
14
These options are available:
15
  -p, --password <password>   PAUSE password.
16
  -u, --user <name>           PAUSE username.
17
EOF
18

            
19
sub run {
20
  my ($self, @args) = @_;
21

            
22
  GetOptionsFromArray \@args,
23
    'p|password=s' => \(my $password = ''),
24
    'u|user=s'     => \(my $user     = '');
25
  die $self->usage unless my $file = shift @args;
26

            
27
  my $tx = Mojo::UserAgent->new->tap(sub { $_->proxy->detect })->post(
28
    "https://$user:$password\@pause.perl.org/pause/authenquery" => form => {
29
      HIDDENNAME                        => $user,
30
      CAN_MULTIPART                     => 1,
31
      pause99_add_uri_upload            => basename($file),
32
      SUBMIT_pause99_add_uri_httpupload => ' Upload this file from my disk ',
33
      pause99_add_uri_uri               => '',
34
      pause99_add_uri_httpupload        => {file => $file},
35
    }
36
  );
37

            
38
  unless ($tx->success) {
39
    my $code = $tx->res->code || '';
40
    my $msg = $tx->error;
41
    if    ($code eq '401') { $msg = 'Wrong username or password.' }
42
    elsif ($code eq '409') { $msg = 'File already exists on CPAN.' }
43
    die qq{Problem uploading file "$file". ($msg)\n};
44
  }
45

            
46
  say 'Upload successful!';
47
}
48

            
49
1;
50

            
51
=encoding utf8
52

            
53
=head1 NAME
54

            
55
Mojolicious::Command::cpanify - Cpanify command
56

            
57
=head1 SYNOPSIS
58

            
59
  use Mojolicious::Command::cpanify;
60

            
61
  my $cpanify = Mojolicious::Command::cpanify->new;
62
  $cpanify->run(@ARGV);
63

            
64
=head1 DESCRIPTION
65

            
66
L<Mojolicious::Command::cpanify> uploads files to CPAN.
67

            
68
This is a core command, that means it is always enabled and its code a good
69
example for learning to build new commands, you're welcome to fork it.
70

            
71
=head1 ATTRIBUTES
72

            
73
L<Mojolicious::Command::cpanify> inherits all attributes from
74
L<Mojolicious::Command> and implements the following new ones.
75

            
76
=head2 description
77

            
78
  my $description = $cpanify->description;
79
  $cpanify        = $cpanify->description('Foo!');
80

            
81
Short description of this command, used for the command list.
82

            
83
=head2 usage
84

            
85
  my $usage = $cpanify->usage;
86
  $cpanify  = $cpanify->usage('Foo!');
87

            
88
Usage information for this command, used for the help screen.
89

            
90
=head1 METHODS
91

            
92
L<Mojolicious::Command::cpanify> inherits all methods from
93
L<Mojolicious::Command> and implements the following new ones.
94

            
95
=head2 run
96

            
97
  $cpanify->run(@ARGV);
98

            
99
Run this command.
100

            
101
=head1 SEE ALSO
102

            
103
L<Mojolicious>, L<Mojolicious::Guides>, L<http://mojolicio.us>.
104

            
105
=cut