This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
More globals in $self
[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
17 chomp(my $git_addr = `git config --get cherrymaint.address`);
18 my $addr = length $git_addr ? $git_addr : 'localhost:3000';
19
20 # Usage
21 my $program = basename $0;
22 my $usage = << "HERE";
23 Usage: $program [--address address] [ACTION] [COMMIT]
24
25   ACTIONS: (default is 'vote' if omitted)
26
27 HERE
28 $usage .= join( "\n", map { "    --$_" } (sort keys %votemap), 'help' );
29 $usage .= "\n" . << "HERE";
30
31   COMMIT: a git revision ID (SHA1 or symbolic reference like HEAD)
32
33 HERE
34
35 die $usage if grep { /^(--help|-h)$/ } @ARGV;
36
37 # Determine action
38 my %opt = (address => \$addr);
39 GetOptions( \%opt, 'address=s', keys %votemap ) or die $usage;
40
41 if ( keys(%opt) > 2 ) {
42   die "Error: cherrymaint takes only one action argument\n\n$usage"
43 }
44
45 my ($action) = grep { exists $votemap{$_} } keys %opt;
46 $action ||= 'vote';
47
48 # Determine commit SHA1
49 my $commit = shift @ARGV;
50
51 unless ( defined $commit ) {
52   die "Error: cherrymaint requires an explicit commit ID\n\n$usage"
53 }
54
55 my $short_id = qx/git rev-parse --short $commit/;
56 if ( $? ) {
57   die "Error: couldn't get git commit SHA1 from '$commit'\n";
58 }
59 chomp $short_id;
60
61 # Confirm actions
62 unless ( $action eq 'vote' ) {
63   say "Are you sure you want to mark $short_id as $action? (y/n)";
64   my $ans = <STDIN>;
65   exit 0 unless $ans =~ /^y/i;
66 }
67
68 # Send the action to cherrymaint
69 my $n = $votemap{$action};
70 my $url = "http://$addr/mark?commit=${short_id}&value=${n}";
71
72 my $ua = LWP::UserAgent->new(
73   agent => 'Porting/cherrymaint ',
74   timeout => 30,
75   env_proxy => 1,
76 );
77
78 my $response = $ua->get($url);
79
80 if ($response->is_success) {
81     say "Done.";
82 }
83 else {
84     die $response->status_line . << "HERE";
85
86 Have you remembered to tunnel $addr to perl5.git.perl.org:3000? E.g.
87   \$ ssh -C -L${\ join q{:} => reverse split /:/, $addr}:3000 perl5.git.perl.org
88
89 Or maybe you created a different tunnel? You can specify the address to use
90 either on the command line with --address, or by doing
91   \$ git config cherrymaint.address host:port
92
93 HERE
94 }
95
96 exit 0;