App-Gitc

 view release on metacpan or  search on metacpan

bin/gitc-fail  view on Meta::CPAN

use Getopt::Long;

my $with_changes = 0;
my $skip_email   = 0;
GetOptions(
    'with-changes' => \$with_changes,
    'skip_email'   => \$skip_email,
    'skip-email'   => \$skip_email,
);

# verify the changeset
my $changeset = current_branch();
die "You can't fail the master branch\n" if $changeset eq 'master';
my $history = history($changeset);
my $status = history_status($history);
die   "This changeset has status '$status' but it must be 'reviewing' for\n"
    . "you to fail it.\n"
    if $status ne 'reviewing';

my $stash;
reversibly {

bin/gitc-pass  view on Meta::CPAN

        . "but got this message: $@\n"
        . "Please help out by doing the above command manually. Thanks.\n"
        ;
}

# reinstate any changes present when we started
git "stash apply $stash" if $stash;

############################### helper subroutines #######################
# tells the user to resolve any merge conflicts, suspends this process
# and waits to be resumed.  Once resumed, verify that the conflict
# was resolved and committed.  If not, let the user try again or
# die.
#
# This code is very similar to code in gitc-promote.  Unfortunately, there
# were enough differences that a common framework couldn't be factored out
# cleanly.
sub let_user_resolve_conflict {
    my ($changeset, $again) = @_;
    if ( not $again ) {
        warn "There were conflicts merging '$changeset' to master.\n";

bin/gitc-pass  view on Meta::CPAN

    }

    my $suspended = 1;
    local $SIG{CONT} = sub { $suspended = 0 };
    kill STOP => $$;
    while ($suspended) { } # spin while signals propagate (necessary?)

    my $confirm_note = q{NOTE: Saying 'no' will abort the pass and put you back into the review branch.};
    my $confirm_text = q{Do you want to try resolving conflicts again?};

    # we're back, verify the state of the tree
    if( git('diff') or git('diff --cached') ) {
        warn "You shall not pass! You have a dirty tree.\n";
        warn "$confirm_note\n";
        if ( confirm($confirm_text) ) {
            return let_user_resolve_conflict($changeset, 'again');
        }
        die "You didn't resolve a merge conflict\n";
    }

    # verify that the previous commit is a merge
    if ( not is_merge_commit('HEAD') ) {
        warn "The most recent commit is not a merge.\n";
        warn "$confirm_note\n";
        if ( confirm($confirm_text) ) {
            return let_user_resolve_conflict($changeset, 'again');
        }
        die   "You were supposed to resolve merge conflicts for '$changeset' but\n"
            . "the most recent commit does not look like a merge commit.\n";
    }

bin/gitc-promote  view on Meta::CPAN

use POSIX qw( strftime );
use Getopt::Long qw( :config pass_through );

# git 1.7.10 added interactive logging of merges.  Since promotions can
# involve hundreds of merges, we really don't want interactive logging.
$ENV{GIT_MERGE_AUTOEDIT} = 'no';

our $dry_run;
our $ignore_dependencies;
our $force;
our $verify_promotion = 1;
our $except;
our $without_theirs;
our $new_major_version;
GetOptions(
    'except|X=s' => \$except,
    'force|f' => \$force,
    'no-verify' => sub { $verify_promotion = 0 },
    'dry-run|n' => \$dry_run,
    'I|ignore-changeset-dependencies' => \$ignore_dependencies,
    'without-theirs' => \$without_theirs,
    'new-major-version' => \$new_major_version,
);
is_suspendable();

my $refs;
my $changesets_list;
our $target;

bin/gitc-promote  view on Meta::CPAN

    my ( $refs, $new_tags )
        = $cherry_pick ? cherry_pick_promotion(@refs) : full_promotion();
    @refs     = @$refs;
    @new_tags = @$new_tags;
    die "You promoted nothing\n" if not @new_tags;

    # display a summary of the promotion
    warn "\nThe proposed promotion has these changes\n";
    git "--no-pager diff --name-status origin/$target $target";

    # encourage the promoter to verify his promotion
    verify_promotion() if $verify_promotion;

    # tag the head of this branch so we have a name for this promotion
    my $tag_name = strftime( "$target/%FT%H_%M_%S", gmtime );
    git_tag( $tag_name, 'HEAD' );
    push @new_tags, $tag_name;
    to_undo { pop @new_tags; git_tag( '-d', $tag_name ); };

    if (project_config()->{use_version_tags}) {
        my $version_tag = new_version_tag( $target, $new_major_version );
        my $cs_msg = join "\n", @$changesets_list;

bin/gitc-promote  view on Meta::CPAN

    # flush the changes
    to_undo { restore_meta_data(); };
    meta_data_rm();
    meta_data_add();

    return ( \@promoted_refs, \@new_tags );
}

# tells the user to resolve any merge conflicts, suspends this process
# and waits to be resumed.  Once resumed, verify that the conflict
# was resolved and committed.  If not, let the user try again or
# die.
sub let_user_resolve_conflict {
    my ($changeset) = @_;
    our $target;

    warn  "\nThere was a conflict promoting '$changeset' to $target.\n"
        . "This process will suspend so that you can manually resolve\n"
        . "the conflict and commit.  Once you've done that, 'fg' this\n"
        . "process and the promotion will continue.\n"
        ;
    my $suspended = 1;
    local $SIG{CONT} = sub { $suspended = 0 };
    kill STOP => $$;
    while ($suspended) { } # spin while signals propagate (necessary?)

    # we're back, verify the state of the tree
    if( git('diff') or git('diff --cached') ) {
        warn "You shouldn't continue promoting with a dirty tree.\n";
        if ( confirm('Do you want to try resolving conflicts again?') ) {
            return let_user_resolve_conflict($changeset);
        }
        warn "You left unresolved conflicts.\n";
        print STDERR
            "What now? p)romote what you have, d)iscard everything: ";
        chomp( my $answer = <STDIN> );
        return 'skip rest' if $answer eq 'p';

bin/gitc-promote  view on Meta::CPAN

    }
    
    # flush the changes
    to_undo { restore_meta_data(); };
    meta_data_rm();
    meta_data_add();

    return ( [], \@new_tags );
}

# allows the promoter to verify the content of the promotion before publishing
# it.  This should be called from inside a reversibly block
sub verify_promotion {
    warn  "\nNow that the promotion is prepared, please verify that\n"
        . "the code works correctly.  This would be a good time to run\n"
        . "the test suite.  When you're finished, 'fg' this process and\n"
        . "you'll have a choice of publishing or canceling the promotion\n"
        ;

    my $suspended = 1;
    local $SIG{CONT} = sub { $suspended = 0 };
    kill STOP => $$;
    while ($suspended) { } # spin while signals propagate (necessary?)

    # we're back, verify the state of the tree
    return if confirm('Is the promotion code correct?');
    die "You said the promotion code was wrong\n";
}

# given the name of a Git tag, returns the corresponding commit time
# as the number of seconds since the Unix epoch
sub tag_time {
    my ($tag) = @_;
    my ($time) = git "log -1 --pretty=format:%ct $tag";
    die "Unable to find tag time for '$tag'" if not $time;

bin/gitc-promoted  view on Meta::CPAN

use List::MoreUtils qw( first_index );

# process command line arguments
our ($period, $bare) = ('sometime');
GetOptions(
    'period|p=s' => \$period,
    'bare|b'     => \$bare,
);
our $target = shift or die "You must specify a promotion target\n";

# parse and verify the period
our ( $start, $end ) = parse_period($period);
die "I don't understand the period '$period'\n" if $start < 0;

my ( $start_stamp, $end_stamp ) = period( local => '%FT%T' );
my @additions = changesets_promoted_between({
    project => scalar project_name(),
    target  => $target,
    start   => $start_stamp,
    end     => $end_stamp,
});

bin/gitc-show  view on Meta::CPAN

    history
    history_status
);
use Getopt::Long qw( :config pass_through );

# should we fetch from the origin?
my $fetch = 0;
GetOptions( 'fetch' => \$fetch );
git "fetch origin" if $fetch;

# verify the changeset name
my $changeset = shift || current_branch();
my $history = history($changeset);
die "There is no changeset named '$changeset'\n" if not @$history;

# validate the changeset status
my $status = history_status($history);
die   "Changeset $changeset has status '$status' so the code only\n"
    . "exists in the developer's personal repository.  If you want\n"
    . "to see what he's up to, ask him nicely to show you.\n"
    if $status eq 'open';

lib/App/Gitc/Its/Eventum.pm  view on Meta::CPAN

    our %eventum;
    my $eventum = $eventum{$uri};
    if ( not $eventum ) {
        require GSG::Eventum;
        # TODO GSG::Eventum has not been publicly released
        $eventum{$uri} = $eventum = GSG::Eventum->new({
            uri      => $uri,
        });
    }

    # GSG::Eventum::Issue is lazy, force an action to verify the issue
    my $issue = $eventum->issue($number);
    $issue = undef if not eval { $issue->summary };
    return $eventum_issue{$number} = $issue;
}


sub transition_state {
    my $self = shift;
    my ($args) = @_;
    $args ||= {};

lib/App/Gitc/Util.pm  view on Meta::CPAN

    return \%config;
}


sub guarantee_a_clean_working_directory {
    my $arguments = "diff -C -M --name-status";
    my $staged    = git "$arguments --cached";
    my $changed   = git $arguments;
    return if not $staged and not $changed;

    # the tree is dirty, verify whether to continue
    warn "It looks like you have uncommitted changes. If this is expected,\n"
       . "type 'y' to continue.  If it's not expected, type 'n'.\n"
       . ( $staged  ? "staged:\n$staged\n"   : '' )
       . ( $changed ? "changed:\n$changed\n" : '' )
       ;
    die "Aborting at the user's request.\n" if not confirm('Continue?');

    # stash the changes to let them be restored later
    my $stash = git "stash create";
    git "reset --hard";

lib/App/Gitc/Util.pm  view on Meta::CPAN

END {
    our $is_suspendable;
    our $suspend_file;
    unlink $suspend_file if $is_suspendable and -e $suspend_file;
}


sub is_valid_ref {
    my ($name) = @_;
    return if not defined $name;
    my $sha1 = eval { git "rev-parse --verify --quiet $name" };
    return $sha1 if $sha1;
    return;
}


sub open_packed_refs {
    my ($prefix) = @_;
    require File::Temp;
    if ( not defined $prefix ) {
        require Carp;
        Carp::croak("open_packed_refs requires a prefix argument");
    }
    my $git_dir = git_dir();
    my $packed_refs = "$git_dir/packed-refs";
    return if not -e $packed_refs;
    open my $old_fh, '<', $packed_refs or die "Can't open $packed_refs: $!";

    # verify that refs were packed with 'peeled'
    my $header = <$old_fh>;
    my ($technique) = $header =~ /^# pack-refs with: (\S+)/;
    $technique ||= '';
    die "Unknown ref packing technique: $technique\n"
        if $technique ne 'peeled';

    # open a temporary file to store the new tags
    my ( $new_fh, $new_filename )
        = File::Temp::tempfile( "$prefix-XXXX", DIR => $git_dir );