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
CommitLineData
813fcdee
DG
1#!/usr/bin/env perl
2use 5.010;
3use strict;
4use warnings;
5use File::Basename;
6use Getopt::Long;
7use LWP::UserAgent;
8
9my %votemap = (
10 'unexamined' => 0,
b63bc9b3
FR
11 'rejected' => 1,
12 'vote' => 4,
13 'picked' => 5,
813fcdee
DG
14);
15
b63bc9b3
FR
16
17chomp(my $git_addr = `git config --get cherrymaint.address`);
18my $addr = length $git_addr ? $git_addr : 'localhost:3000';
19
813fcdee
DG
20# Usage
21my $program = basename $0;
22my $usage = << "HERE";
b63bc9b3 23Usage: $program [--address address] [ACTION] [COMMIT]
813fcdee
DG
24
25 ACTIONS: (default is 'vote' if omitted)
26
27HERE
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
33HERE
34
35die $usage if grep { /^(--help|-h)$/ } @ARGV;
36
37# Determine action
b63bc9b3
FR
38my %opt = (address => \$addr);
39GetOptions( \%opt, 'address=s', keys %votemap ) or die $usage;
813fcdee 40
e2880212 41if ( keys(%opt) > 2 ) {
b63bc9b3 42 die "Error: cherrymaint takes only one action argument\n\n$usage"
813fcdee
DG
43}
44
b63bc9b3 45my ($action) = grep { exists $votemap{$_} } keys %opt;
813fcdee
DG
46$action ||= 'vote';
47
48# Determine commit SHA1
49my $commit = shift @ARGV;
50
51unless ( defined $commit ) {
52 die "Error: cherrymaint requires an explicit commit ID\n\n$usage"
53}
54
55my $short_id = qx/git rev-parse --short $commit/;
56if ( $? ) {
57 die "Error: couldn't get git commit SHA1 from '$commit'\n";
58}
59chomp $short_id;
60
61# Confirm actions
62unless ( $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
69my $n = $votemap{$action};
b63bc9b3 70my $url = "http://$addr/mark?commit=${short_id}&value=${n}";
813fcdee
DG
71
72my $ua = LWP::UserAgent->new(
73 agent => 'Porting/cherrymaint ',
74 timeout => 30,
75 env_proxy => 1,
76);
77
78my $response = $ua->get($url);
79
80if ($response->is_success) {
81 say "Done.";
82}
83else {
b63bc9b3
FR
84 die $response->status_line . << "HERE";
85
86Have 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
89Or maybe you created a different tunnel? You can specify the address to use
90either on the command line with --address, or by doing
91 \$ git config cherrymaint.address host:port
813fcdee 92
813fcdee
DG
93HERE
94}
95
96exit 0;