This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Pod formatting fix for perl5132delta
[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,
11 'rejected' => 1,
12 'vote' => 4,
13 'picked' => 5,
14);
15
16# Usage
17my $program = basename $0;
18my $usage = << "HERE";
19Usage: $program [ACTION] [COMMIT]
20
21 ACTIONS: (default is 'vote' if omitted)
22
23HERE
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
29HERE
30
31die $usage if grep { /^(--help|-h)$/ } @ARGV;
32
33# Determine action
34my %opt;
35GetOptions( \%opt, keys %votemap ) or die $usage;
36
37if ( keys(%opt) > 1 ) {
38 die "Error: cherrymaint takes only one action argument\n\n$usage"
39}
40
41my ($action) = keys %opt;
42$action ||= 'vote';
43
44# Determine commit SHA1
45my $commit = shift @ARGV;
46
47unless ( defined $commit ) {
48 die "Error: cherrymaint requires an explicit commit ID\n\n$usage"
49}
50
51my $short_id = qx/git rev-parse --short $commit/;
52if ( $? ) {
53 die "Error: couldn't get git commit SHA1 from '$commit'\n";
54}
55chomp $short_id;
56
57# Confirm actions
58unless ( $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
65my $n = $votemap{$action};
66my $url = "http://localhost:3000/mark?commit=${short_id}&value=${n}";
67
68my $ua = LWP::UserAgent->new(
69 agent => 'Porting/cherrymaint ',
70 timeout => 30,
71 env_proxy => 1,
72);
73
74my $response = $ua->get($url);
75
76if ($response->is_success) {
77 say "Done.";
78}
79else {
80 die $response->status_line . << 'HERE';
81
82Have you remembered to tunnel localhost:3000 to perl5.git.perl.org:3000? E.g.
83 $ ssh -C -L3000:localhost:3000 perl5.git.perl.org
84HERE
85}
86
87exit 0;