view release on metacpan or  search on metacpan

bin/gitc-pass  view on Meta::CPAN

use strict;
use warnings;

#    Copyright 2012 Grant Street Group, All Rights Reserved.
#
#    This program is free software: you can redistribute it and/or modify
#    it under the terms of the GNU Affero General Public License as
#    published by the Free Software Foundation, either version 3 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 Affero General Public License for more details.
#
#    You should have received a copy of the GNU Affero General Public License
#    along with this program.  If not, see <http://www.gnu.org/licenses/>.

# PODNAME: gitc-pass
# ABSTRACT: Pass a changeset review
our $VERSION = '0.60'; # VERSION

use App::Gitc::Util qw(
    confirm
    current_branch
    full_changeset_name
    get_user_name
    get_user_email
    git
    git_tag
    guarantee_a_clean_working_directory
    history
    history_status
    history_submitter
    is_merge_commit
    is_suspendable
    its_for_changeset
    meta_data_add
    meta_data_rm
    project_name
    sendmail
    sort_changesets_by_name
    unpromoted
);
use App::Gitc::Reversible;
use Getopt::Long;

my $skip_email = 0;
my $self_review = 0;
GetOptions(
    'skip-email' => \$skip_email,
    'from-self-review' => sub {
        $self_review = 1;
        $skip_email  = 1;
    },
);
is_suspendable();
my $changeset = current_branch();
die "You can't pass the master branch\n" if $changeset eq 'master';

# validate the current status
my $history = history($changeset);
my $status = history_status($history);
die   "This changeset has status '$status' but it must be 'reviewing' for\n"
    . "you to pass it.\n"
    if $status ne 'reviewing';

my $stash;
my $send_email;
reversibly {
    failure_warning "\nAborting gitc pass\n";

    $stash = guarantee_a_clean_working_directory();
    to_undo { git "stash apply $stash" if $stash; $stash = undef };

    # tag the head of our changeset branch
    git_tag( "cs/$changeset/head", 'HEAD' );
    to_undo { git_tag( '-d', "cs/$changeset/head" ) };

    # make sure that our repository and master branch are up to date
    git "fetch origin" if not $self_review;  # self-review just fetched
    git "checkout master";
    git "reset --hard origin/master";
    to_undo { git "checkout -f $changeset" };

    my $full = full_changeset_name($changeset);
    my @unmerged = grep {
        $_ ne $changeset
    } unpromoted( $full, 'origin/master' );
    if (@unmerged) {
        sort_changesets_by_name(\@unmerged);
        warn "This changeset depends on $_, which is not yet merged.\n"
            for @unmerged;
        die   "This changeset cannot be merged until its dependencies "
            . "are merged.\n";
    }

    # merge the changeset to master and tag the merge point
    eval {
        my $output = git "merge --no-ff $changeset";
        to_undo { git "reset --hard origin/master" };
        die "Merge conflicts\n" if $output =~ m/Automatic merge failed/;
    };
    let_user_resolve_conflict($changeset) if $@;
    git_tag( "cs/$changeset/to-master", 'HEAD' );
    to_undo { git_tag( '-d', "cs/$changeset/to-master" ) };

    # delete branches we don't need anymore
    failure_warning "\nAborting gitc pass\n";
    git "branch -d $changeset";
    to_undo { git "branch $changeset cs/$changeset/head" };
    if ( not $self_review ) {
        git "branch -D -r origin/pu/$changeset";
        to_undo { git "fetch origin" };
    }

    # send a pass email
    if ( not $skip_email ) {
        my $history = history($changeset);
        my $to_master = "cs/$changeset/to-master";
        my $patch = git "diff --no-prefix --no-color --stat -p $to_master~1 $to_master";