File Coverage

blib/lib/App/PAUSE/Comaint.pm
Criterion Covered Total %
statement 14 68 20.5
branch 0 22 0.0
condition 0 6 0.0
subroutine 5 11 45.4
pod 0 6 0.0
total 19 113 16.8


line stmt bran cond sub pod time code
1             package App::PAUSE::Comaint;
2              
3 1     1   71475 use strict;
  1         2  
  1         30  
4 1     1   30 use 5.008_001;
  1         4  
5             our $VERSION = '0.08';
6              
7 1     1   443 use App::PAUSE::Comaint::PackageScanner;
  1         5  
  1         35  
8 1     1   795 use WWW::Mechanize;
  1         111876  
  1         64  
9 1     1   1028 use ExtUtils::MakeMaker qw(prompt);
  1         100682  
  1         931  
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           my %rc;
42 0           my $file = "$ENV{HOME}/.pause";
43 0 0         if (eval { require Config::Identity }) {
  0            
44 0           %rc = Config::Identity->load($file);
45             } else {
46 0 0         open my $in, "<", $file
47             or die "Can't open $file: $!";
48 0           while (<$in>) {
49 0 0         /^(\S+)\s+(.*)/ and $rc{$1} = $2;
50             }
51             }
52              
53 0           return @rc{qw(user password)};
54             }
55              
56             sub login_pause {
57 0     0 0   my $self = shift;
58              
59 0           $self->mech->credentials($self->get_credentials);
60 0           $self->mech->get("https://pause.perl.org/pause/authenquery?ACTION=share_perms");
61              
62 0           $self->mech->form_number(1);
63 0           $self->mech->click('weaksubmit_pause99_share_perms_makeco');
64              
65 0 0         $self->mech->content =~ /Select a co-maintainer/
66             or die "Something is wrong with Screen-scraping: ", $self->mech->content;
67             }
68              
69             sub make_comaint {
70 0     0 0   my($self, $author, $packages) = @_;
71              
72 0           my %try = map { $_ => 1 } @$packages;
  0            
73              
74 0           my $form = $self->mech->form_number(1);
75              
76 0           for my $input ($form->find_input('pause99_share_perms_makeco_m')) {
77 0           my $value = ($input->possible_values)[1];
78 0 0         if ($try{$value}) {
79 0           $input->check;
80 0           delete $try{$value};
81             }
82             }
83              
84 0 0         if (keys %try) {
85 0           my $msg = "You don't seem to be a primary maintainer of the following modules:\n";
86 0           for my $module (sort keys %try) {
87 0           $msg .= " $module\n";
88             }
89 0           die $msg;
90             }
91              
92 0           $form->find_input("pause99_share_perms_makeco_a")->value($author);
93              
94 0           print "Going to make $author as a comaint of the following modules.\n\n";
95 0           for my $package (@$packages) {
96 0           print " $package\n";
97             }
98 0           print "\n";
99              
100 0           my $value = prompt "Are you sure?", "y";
101 0 0         return if lc($value) ne 'y';
102              
103 0           $self->mech->click_button(value => 'Make Co-Maintainer');
104              
105 0 0         if (my @results = ($self->mech->content =~ /

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

106 0           print "\n", join("\n", @results), "\n";
107             } else {
108 0           warn "Something's wrong: ", $self->mech->content;
109             }
110             }
111              
112              
113             1;
114             __END__