This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Add command line tool to update cherrymaint
[perl5.git] / Porting / cherrymaint
1 #!/usr/bin/env perl
2 use 5.010;
3 use strict;
4 use warnings;
5 use File::Basename;
6 use Getopt::Long;
7 use LWP::UserAgent;
8
9 my %votemap = (
10   'unexamined' => 0,
11   'rejected' => 1,
12   'vote' => 4,
13   'picked' => 5,
14 );
15
16 # Usage
17 my $program = basename $0;
18 my $usage = << "HERE";
19 Usage: $program [ACTION] [COMMIT]
20
21   ACTIONS: (default is 'vote' if omitted)
22
23 HERE
24 $usage .= join( "\n", map { "    --$_" } (sort keys %votemap), 'help' );
25 $usage .= "\n" . << "HERE";
26
27   COMMIT: a git revision ID (SHA1 or symbolic reference like HEAD)
28
29 HERE
30
31 die $usage if grep { /^(--help|-h)$/ } @ARGV;
32
33 # Determine action
34 my %opt;
35 GetOptions( \%opt, keys %votemap ) or die $usage;
36
37 if ( keys(%opt) > 1 ) {
38   die "Error: cherrymaint takes only one action argument\n\n$usage" 
39 }
40
41 my ($action) = keys %opt;
42 $action ||= 'vote';
43
44 # Determine commit SHA1
45 my $commit = shift @ARGV;
46
47 unless ( defined $commit ) {
48   die "Error: cherrymaint requires an explicit commit ID\n\n$usage"
49 }
50
51 my $short_id = qx/git rev-parse --short $commit/;
52 if ( $? ) {
53   die "Error: couldn't get git commit SHA1 from '$commit'\n";
54 }
55 chomp $short_id;
56
57 # Confirm actions
58 unless ( $action eq 'vote' ) {
59   say "Are you sure you want to mark $short_id as $action? (y/n)";
60   my $ans = <STDIN>;
61   exit 0 unless $ans =~ /^y/i;
62 }
63
64 # Send the action to cherrymaint
65 my $n = $votemap{$action};
66 my $url = "http://localhost:3000/mark?commit=${short_id}&value=${n}";
67
68 my $ua = LWP::UserAgent->new(
69   agent => 'Porting/cherrymaint ',
70   timeout => 30,
71   env_proxy => 1,
72 );
73
74 my $response = $ua->get($url);
75
76 if ($response->is_success) {
77     say "Done.";
78 }
79 else {
80     die $response->status_line . << 'HERE';
81
82 Have you remembered to tunnel localhost:3000 to perl5.git.perl.org:3000? E.g.
83   $ ssh -C -L3000:localhost:3000 perl5.git.perl.org
84 HERE
85 }
86
87 exit 0;