| 1 | #!/usr/bin/env perl |
| 2 | use 5.010; |
| 3 | use strict; |
| 4 | use warnings; |
| 5 | use File::Basename; |
| 6 | use Getopt::Long; |
| 7 | require 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 | You must first tunnel $addr to perl5.git.perl.org:3000? E.g. |
| 34 | \$ ssh -C -L${\ join q{:} => reverse split /:/, $addr}:3000 perl5.git.perl.org |
| 35 | |
| 36 | HERE |
| 37 | |
| 38 | die $usage if grep { /^(--help|-h)$/ } @ARGV; |
| 39 | |
| 40 | # Determine action |
| 41 | my %opt = (address => \$addr); |
| 42 | GetOptions( \%opt, 'address=s', keys %votemap ) or die $usage; |
| 43 | |
| 44 | if ( keys(%opt) > 2 ) { |
| 45 | die "Error: cherrymaint takes only one action argument\n\n$usage" |
| 46 | } |
| 47 | |
| 48 | my ($action) = grep { exists $votemap{$_} } keys %opt; |
| 49 | $action ||= 'vote'; |
| 50 | |
| 51 | # Determine commit SHA1 |
| 52 | my $commit = shift @ARGV; |
| 53 | |
| 54 | unless ( defined $commit ) { |
| 55 | die "Error: cherrymaint requires an explicit commit ID\n\n$usage" |
| 56 | } |
| 57 | |
| 58 | my $short_id = qx/git rev-parse --short $commit/; |
| 59 | if ( $? ) { |
| 60 | die "Error: couldn't get git commit SHA1 from '$commit'\n"; |
| 61 | } |
| 62 | chomp $short_id; |
| 63 | |
| 64 | # Confirm actions |
| 65 | unless ( $action eq 'vote' ) { |
| 66 | say "Are you sure you want to mark $short_id as $action? (y/n)"; |
| 67 | my $ans = <STDIN>; |
| 68 | exit 0 unless $ans =~ /^y/i; |
| 69 | } |
| 70 | |
| 71 | # Send the action to cherrymaint |
| 72 | my $n = $votemap{$action}; |
| 73 | my $url = "http://$addr/mark?commit=${short_id}&value=${n}"; |
| 74 | |
| 75 | my $ua = LWP::UserAgent->new( |
| 76 | agent => 'Porting/cherrymaint ', |
| 77 | timeout => 30, |
| 78 | env_proxy => 1, |
| 79 | ); |
| 80 | |
| 81 | my $response = $ua->get($url); |
| 82 | |
| 83 | if ($response->is_success) { |
| 84 | say "Done."; |
| 85 | } |
| 86 | else { |
| 87 | die $response->status_line . << "HERE"; |
| 88 | |
| 89 | Have you remembered to tunnel $addr to perl5.git.perl.org:3000? E.g. |
| 90 | \$ ssh -C -L${\ join q{:} => reverse split /:/, $addr}:3000 perl5.git.perl.org |
| 91 | |
| 92 | Or maybe you created a different tunnel? You can specify the address to use |
| 93 | either on the command line with --address, or by doing |
| 94 | \$ git config cherrymaint.address host:port |
| 95 | |
| 96 | HERE |
| 97 | |
| 98 | # Note that you can vote through your browser by pointing it at the local |
| 99 | # end of the tunnel. For example, L<http://localhost:3000/> if you went with |
| 100 | # the suggested default values |
| 101 | } |
| 102 | |
| 103 | exit 0; |