File Coverage

blib/lib/App/PAUSE/Comaint.pm
Criterion Covered Total %
statement 14 64 21.8
branch 0 20 0.0
condition 0 6 0.0
subroutine 5 11 45.4
pod 0 6 0.0
total 19 107 17.7


line stmt bran cond sub pod time code
1             package App::PAUSE::Comaint;
2              
3 1     1   14471 use strict;
  1         1  
  1         22  
4 1     1   16 use 5.008_001;
  1         3  
5             our $VERSION = '0.07';
6              
7 1     1   379 use App::PAUSE::Comaint::PackageScanner;
  1         3  
  1         43  
8 1     1   1001 use WWW::Mechanize;
  1         83417  
  1         36  
9 1     1   766 use ExtUtils::MakeMaker qw(prompt);
  1         106912  
  1         1077  
10              
11             sub new {
12 0     0 0   my($class) = @_;
13 0           bless { mech => WWW::Mechanize->new }, $class;
14             }
15              
16 0     0 0   sub mech { $_[0]->{mech} }
17              
18             sub run {
19 0     0 0   my($self, $module, $comaint) = @_;
20              
21 0 0 0       unless ($module && $comaint) {
22 0           die "Usage: comaint Module AUTHOR\n";
23             }
24              
25 0 0 0       if ($module =~ /^[A-Z]+$/ && $comaint =~ /::/) {
26 0           die "Usage: comaint Module AUTHOR\n";
27             }
28              
29 0           my $scanner = App::PAUSE::Comaint::PackageScanner->new('http://cpanmetadb.plackperl.org');
30 0           my @packages = $scanner->find($module);
31              
32 0 0         @packages or die "Couldn't find module '$module' in 02packages\n";
33              
34 0           $self->login_pause;
35 0           $self->make_comaint($comaint, \@packages);
36             }
37              
38             sub get_credentials {
39 0     0 0   my $self = shift;
40              
41 0 0         open my $in, "<", "$ENV{HOME}/.pause"
42             or die "Can't open ~/.pause: $!";
43 0           my %rc;
44 0           while (<$in>) {
45 0 0         /^(\S+)\s+(.*)/ and $rc{$1} = $2;
46             }
47              
48 0           return @rc{qw(user password)};
49             }
50              
51             sub login_pause {
52 0     0 0   my $self = shift;
53              
54 0           $self->mech->credentials($self->get_credentials);
55 0           $self->mech->get("https://pause.perl.org/pause/authenquery?ACTION=share_perms");
56              
57 0           $self->mech->form_number(1);
58 0           $self->mech->click('weaksubmit_pause99_share_perms_makeco');
59              
60 0 0         $self->mech->content =~ /Select a co-maintainer/
61             or die "Something is wrong with Screen-scraping: ", $self->mech->content;
62             }
63              
64             sub make_comaint {
65 0     0 0   my($self, $author, $packages) = @_;
66              
67 0           my %try = map { $_ => 1 } @$packages;
  0            
68              
69 0           my $form = $self->mech->form_number(1);
70              
71 0           for my $input ($form->find_input('pause99_share_perms_makeco_m')) {
72 0           my $value = ($input->possible_values)[1];
73 0 0         if ($try{$value}) {
74 0           $input->check;
75 0           delete $try{$value};
76             }
77             }
78              
79 0 0         if (keys %try) {
80 0           my $msg = "You don't seem to be a primary maintainer of the following modules:\n";
81 0           for my $module (sort keys %try) {
82 0           $msg .= " $module\n";
83             }
84 0           die $msg;
85             }
86              
87 0           $form->find_input("pause99_share_perms_makeco_a")->value($author);
88              
89 0           print "Going to make $author as a comaint of the following modules.\n\n";
90 0           for my $package (@$packages) {
91 0           print " $package\n";
92             }
93 0           print "\n";
94              
95 0           my $value = prompt "Are you sure?", "y";
96 0 0         return if lc($value) ne 'y';
97              
98 0           $self->mech->click_button(value => 'Make Co-Maintainer');
99              
100 0 0         if (my @results = ($self->mech->content =~ /

(Added .*? to co-maint.*?|\w+ was already a co-maint.*?: skipping)<\/p>/g)) {

101 0           print "\n", join("\n", @results), "\n";
102             } else {
103 0           warn "Something's wrong: ", $self->mech->content;
104             }
105             }
106              
107              
108             1;
109             __END__