App-KGB
view release on metacpan or search on metacpan
lib/App/KGB/Client/Git.pm view on Meta::CPAN
return $result;
}
sub _describe_branch_updates {
my ( $self ) = @_;
my %ref_branch;
my %ref_parent;
my @new_branches;
my %new_branches;
my @updated_branches;
my %branch_updates;
my %branch_head;
my %updated_heads;
my @old_revs;
# keys are sha1s, values are hashrefs with keys branch names
my %branch_tips;
warn "# ======== processing changesets" if 0;
my @params = qw(--topo-order --parents --first-parent);
my @updated;
my %branch_has_commits;
for my $cs ( @{ $self->changesets } ) {
my ( $old, $new, $ref ) = @$cs;
warn "# considering $old $new $ref" if 0;
next unless $ref =~ m{^refs/heads/(.+)}; # not interested in tags
my $branch = $1;
next if $new =~ /^0+$/; # nor dropped branches
$ref_branch{$new} = $branch;
warn "# $new is on $branch" if 0;
warn "$branch head is $new" if 0;
$branch_head{$branch} = $new;
$branch_tips{$new}{$branch} = 1;
$updated_heads{$branch} = 1;
if ( $old =~ /^0+$/ ) {
push @new_branches, $branch;
$new_branches{$branch} = 1;
}
else {
push @updated, "$new", "^$old";
push @old_revs, $old;
push @updated_branches, $branch;
$branch_updates{$branch} = [ $old => $new ];
}
}
my @existing_branches;
my @old_branches;
my @lines
= $self->_git->command( 'branch', '-v', '--no-abbrev' );
for my $l (@lines) {
$l =~ s/^[ *]+//;
lib/App/KGB/Client/Git.pm view on Meta::CPAN
push @old_branches, $ref
unless $new_branches{$ref}
or $branch_updates{$ref};
}
warn "existing branches: @existing_branches" if 0;
warn "old branches: @old_branches" if 0;
my @commits;
my %reported;
if (@updated) {
push @params, map( "^$_", @old_branches );
warn "# git rev-list @params @updated" if 0;
my @lines = $self->_git->command( 'rev-list', @params, @updated);
do { warn $_ for @lines } if 0;
if ( $self->squash_threshold
and scalar(@lines) > $self->squash_threshold )
{
for my $branch (@updated_branches) {
my ($old,$new) = @{ $branch_updates{$branch} };
my $stat = $self->_git->command( 'diff', '--shortstat',
"$old..$new" );
my @commit_lines
= $self->_git->command( 'rev-list', '--topo-order', $new,
"^$old" );
push @commits,
$self->format_message(
$self->squash_msg_template,
branch => $branch,
lib/App/KGB/Client/Git.pm view on Meta::CPAN
}
my $cmt = App::KGB::Commit->new( $self->_describe_ref($ref) );
warn "# putting $ref on $ref_branch{$ref}" if 0;
$cmt->branch( $ref_branch{$ref} );
unshift @commits, $cmt;
$reported{$ref} = 1;
$branch_has_commits{ $ref_branch{$ref} } = 1;
}
}
# see if some updated branch was without any reported commits
# if this case put a fast-forward notification
if ( $self->enable_branch_ff_notification ) {
for ( @updated_branches ) {
next if $branch_has_commits{$_};
push @commits,
App::KGB::Commit->new(
{ branch => $_,
id => substr( $branch_updates{$_}[1], 0, 7 ),
author => $ENV{USER},
author_name => $self->_get_full_user_name,
log => 'fast forward',
}
lib/App/KGB/Client/Git.pm view on Meta::CPAN
}
# walk the branch until it is exhausted or a revision with multiple
# children (branch point) is reached
# when walking skip all commits already reported
# terminate walk on old revs
if ( @new_branches ) {
# exclude commits in all branches that aren't part of this push
my @exclude;
for ( @existing_branches ) {
push @exclude, $branch_head{$_} unless $updated_heads{$_};
};
push @exclude, @old_revs;
$_ = "^$_" for @exclude;
for my $b (@new_branches) {
warn "# Looking into new branch $b" if 0;
warn "# git rev-list --topo-order --first-parent --parents $b @exclude" if 0;
my @lines = $self->_git->command( 'rev-list', '--topo-order',
'--first-parent', '--parents', $b, @exclude );
script/kgb-client view on Meta::CPAN
=item B<kgb-client> --help
=item B<kgb-client> --man
=back
=head1 DESCRIPTION
B<kgb-client> is the client counterpart of L<kgb-bot(1)>. It is intended to be
used as a hook in your version control system, executed after the repository
gets updated. It analyzes the commit(s) and then relays the information to the
KGB server, which will show it on IRC.
=head1 CONFIGURATION
=over
=item B<--conf> I<configuration file>
Specifies the path to kgb-client configuration file.
t/53-client-git-merges.t view on Meta::CPAN
. $commit->id.'' );
#### branch, two changes, merge. then the changes should be reported only once
my $b1 = 'a-new';
$ign = $git->command( [ 'checkout', '-b', $b1, 'master' ],
{ STDERR => 0 } );
w( 'new', 'content' );
$ign = $git->command( 'add', 'new' );
$ign = $git->command( 'commit', '-m', 'created new content' );
w( 'new', 'more content' );
$ign = $git->command( 'commit', '-a', '-m', 'updated new content' );
$ign = $git->command( 'checkout', '-q', 'master' );
$ign = $git->command( 'merge', '--no-ff', '-m', "merge '$b1' into master", $b1 );
# same with a branch name sorting after 'master'
my $b2 = 'new-content';
$ign = $git->command( [ 'checkout', '-b', $b2, 'master' ],
{ STDERR => 0 } );
w( 'new', 'content' );
$ign = $git->command( 'add', 'new' );
$ign = $git->command( 'commit', '-m', 'created new content' );
w( 'new', 'more content' );
$ign = $git->command( 'commit', '-a', '-m', 'updated new content' );
$ign = $git->command( 'checkout', '-q', 'master' );
$ign = $git->command( 'merge', '--no-ff', '-m', "merge '$b2' into master", $b2 );
push_ok();
$commit = $c->describe_commit;
ok( defined($commit), 'merge commit exists' );
is( $commit->branch, 'master' );
is( $commit->log, "merge '$b1' into master" );
TestBot->expect( 'dummy/#test 12test/03there 05master '
t/53-client-git-merges.t view on Meta::CPAN
TestBot->expect( 'dummy/#test 12test/03there 05a-new '
. $commit->id
. ' 06Test U. Ser (06ser) 03new created new content * 14http://scm.host.org/there/a-new/?commit='
. $commit->id
. '' );
$commit = $c->describe_commit;
ok( defined($commit), "second $b1 commit exists" );
is( $commit->branch, $b1 );
is( $commit->log, "updated new content" );
TestBot->expect( 'dummy/#test 12test/03there 05a-new '
. $commit->id
. ' 06Test U. Ser (06ser) 10new updated new content * 14http://scm.host.org/there/a-new/?commit='
. $commit->id
. '' );
$commit = $c->describe_commit;
ok( defined($commit), "first $b2 commit exists" );
is( $commit->branch, $b2 );
is( $commit->log, "created new content" );
TestBot->expect( 'dummy/#test 12test/03there 05new-content '
. $commit->id
. ' 06Test U. Ser (06ser) 10new created new content * 14http://scm.host.org/there/new-content/?commit='
. $commit->id
. '' );
$commit = $c->describe_commit;
ok( defined($commit), "second $b2 commit exists" );
is( $commit->branch, $b2 );
is( $commit->log, "updated new content" );
TestBot->expect( 'dummy/#test 12test/03there 05new-content '
. $commit->id
. ' 06Test U. Ser (06ser) 10new updated new content * 14http://scm.host.org/there/new-content/?commit='
. $commit->id
. '' );
##### No more commits after the last
$commit = $c->describe_commit;
is( $commit, undef );
my $output = $test_bot->get_output;
undef($test_bot); # make sure all output us there
t/54-client-git-squash.t view on Meta::CPAN
TestBot->expect( 'dummy/#test 12test/03there 05master '
. $commit->id
. ' 06Test U. Ser (06ser) 03old import old content * 14http://scm.host.org/there/master/?commit='
. $commit->id
. '' );
w( 'new', 'content' );
$git->command( 'add', 'new' );
$git->command( 'commit', '-m', 'created new content' );
w( 'new', 'more content' );
$git->command( 'commit', '-a', '-m', 'updated new content' );
a( 'new', 'even more content' );
do_commit('another update' );
push_ok;
$commit = $c->describe_commit;
ok( defined($commit), 'squashed commit exists' ) or BAIL_OUT 'will fail anyway';
ok( !ref($commit), 'squashed commit is a plain string' ) or BAIL_OUT 'will fail anyway';
my $commit_id = shift @{ $commits{master} };
( run in 0.283 second using v1.01-cache-2.11-cpan-05444aca049 )