git pastebin

#!/usr/bin/env perl
#
# Arguments are:
#  git pastebin [<commit>]
#

# Copyright (C) Thiago Macieira <thiago@kde.org>
# This program is based on paste2pastebin.pl, that is
#   Copyright (C) Fred Blaise <chapeaurouge_at_madpenguin_dot_org>
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA

use strict;
use WWW::Mechanize;

my $description;
my $content;
my $squash = -1;
my @committish;
my @fpargs;
my @pathargs;
my $dashdash = 0;

while (scalar @ARGV) {
    my $arg = shift @ARGV;

    if ($arg eq "-d" || $arg eq "--description") {
	die "Option $arg requires an argument" unless scalar @ARGV;
	$description = shift @ARGV;
    } elsif ($arg eq "-s" || $arg eq "--squash") {
	$squash = 1;
    } elsif ($arg eq "--no-squash") {
	$squash = 0;
    } elsif ($arg eq "--") {
	$dashdash = 1;
    } elsif ($arg =~ m/^-/) {
	push @fpargs, $arg;
    } elsif ($dashdash) {
        push @pathargs, $arg;
    } else {
	push @committish, $arg;
    }
}

# Squash by default if description was given
$squash = $description if ($squash == -1);

# Default revision is HEAD
push @committish, "HEAD" unless (scalar @committish);

# Prepend -- if pathargs isn't empty
unshift @pathargs, "--" if (scalar @pathargs);

# Try to parse this commit
my @revlist;
my $needsrevlist = 0;
open REVPARSE, "-|", "git", "rev-parse", @committish;
while (<REVPARSE>) {
    chomp;
    push @revlist, $_;
    $needsrevlist = 1 if (m/^\^/);
}
close REVPARSE;

if ($needsrevlist) {
    # Get the revision list then
    open REVLIST, "-|", "git", "rev-list", "--reverse", @revlist
	or die "Cannot run git-rev-list: $!";
    @revlist = ();
    while (<REVLIST>) {
	chomp;
	push @revlist, $_;
    }
    close REVLIST;
}

# Are we squashing?
if (scalar @revlist > 1 && $squash) {
    # Yes, this one is easy
    open FORMATPATCH, "-|", "git", "format-patch", "--stdout", @fpargs, @committish, @pathargs
	or die "Cannot run git format-patch: $!";

    while (<FORMATPATCH>) {
        $content .= $_;
    }
    close FORMATPATCH;

    submit($description, $content);
    exit(0);
}

# No, we're not squashing
# Iterate over the commits
for my $rev (@revlist) {
    $content = "";
    $description = "";

    # Get description
    open PRETTY, "-|", "git", "log", "--pretty=format:%s%n%b", "$rev^!"
        or die "Cannot get description for $rev: $!";
    while (<PRETTY>) {
	$description .= $_;
    }
    close PRETTY;

    # Get patch
    open FORMATPATCH, "-|", "git", "format-patch", "--stdout", @fpargs, "$rev^!", @pathargs
	or die "Cannot get patch for $rev: $!";
    while (<FORMATPATCH>) {
        $content .= $_;
    }
    close FORMATPATCH;

    submit($description, $content);
}

sub submit($$) {
    my ($description, $content) = @_;
    my %fields = (
        content         =>      $content,
        description     =>      $description,
        type            =>      '34', # Unfortunately, "Diff/Patch" is missing in the quiet interface
        expiry          =>      '1 month',
        name            =>      '',
    );
    my $www = WWW::Mechanize->new();

    my $api_key       = "1OIIB1/PYzkNe/azsjOFkm4iBe0414V0";
    my $pastebin_url  = "http://pastebin.ca/quiet-paste.php?api=$api_key";
    my $pastebin_root = "http://pastebin.ca";

    $www->get($pastebin_url);
    die "Cannot get the pastebin form: $!" unless ($www->success());

    $www->form_name('pasteform');
    $www->set_fields(%fields);
    $www->submit_form(button => 's');

    die "Could not send paste: $!" unless ($www->success());

    $content = $www->content();
    if($content =~ m/^SUCCESS:(.*)/) {
        print "$pastebin_root/$1\n";
    } else {
        print $content;
    }
}