view release on metacpan or  search on metacpan

lib/App/KGB/Client/Git.pm  view on Meta::CPAN

            $log[0] .= " ($log[1])";
            $#log = 0;
        }
    }

    return App::KGB::Commit::Tag->new(
        {   id     => substr( $ref, 0, 7 ),
            author => $author_login,
            author_name => $author_name,
            log    => join( "\n", @log ),
            branch  => $signed ? 'signed tags' : 'tags',
            changes => [ App::KGB::Change->new("(A)$tag") ],
            tag_name => $tag,
        }
    );
}

=item format_git_stat I<text>

returns a colored version of I<text>, which is expected to be the result
of C<git diff --shortstat>.

=cut

sub format_git_stat {
    my ( $self, $text ) = @_;

    my $result = '';

    $self->init_painter;

    while ( length($text) ) {
        warn "$text" if 0;
        if ( $text =~ s/\s*(.*?)(\d+ files? changed)// ) {
            $result .= $1 . $self->colorize( modification => $2 );
            next;
        }
        if ( $text =~ s/\s*(.*?)(\d+) insertions?\(\++\)// ) {
            $result .= $1 . $self->colorize( addition => "$2(+)" );
            next;
        }
        if ( $text =~ s/\s*(.*?)(\d+) deletions?\(-+\)// ) {
            $result .= $1 . $self->colorize( deletion => "$2(-)" );
            next;
        }

        # nothing matched
        $result .= $text;
        last;
    }

    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/^[ *]+//;
        my ( $ref, $sha, $ignore ) = split( ' ', $l );
        $branch_head{$ref} = $sha;
        $branch_tips{$sha}{$ref} = 1;
        $ref_branch{$sha} //= $ref;
        push @existing_branches, $ref unless $new_branches{$ref};
        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,
                    commit_id    => substr( $new, 0, 7 ),
                    author_login => $ENV{USER},
                    author_name  => $self->_get_full_user_name,
                    log          => sprintf(
                        '%d commits pushed, %s',
                        scalar(@commit_lines), $self->format_git_stat($stat),
                    ),
                    );
                warn "# $commits[-1]" if 0;
                $branch_has_commits{$branch} = 1;
            }
        }
        else {
            my @refs;
            for (@lines) {
                my ( $ref, @parents ) = split(/\s+/);

                push @refs, $ref;

                if ( @parents and not $ref_branch{ $parents[0] } ) {
                    $ref_branch{ $parents[0] } = $ref_branch{$ref}
                        or confess
                        "Ref $ref with parent $parents[0] is of unknown branch";
                    warn
                        "# $parents[0] determined to be on branch $ref_branch{$ref}"
                        if 0;
                }
            }

            warn "# revisions to describe: " . join( ' ', @refs ) if 0;

            for my $ref (@refs) {
                if ( $reported{$ref} ) {
                    warn "$ref already reported" if 0;
                    next;
                }
                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',
                    }
                    );
            }
        }
    }

    # 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 );

            my @br_commits;
            my $branch_point;

            my $last_rev;
            for my $line (@lines) {
                warn "# $line" if 0;
                my ( $rev, $parent, @other_parents ) = split( /\s+/, $line );
                $last_rev = $rev;
                if ( $reported{$rev} ) {
                    warn "$rev is already reported" if 0;
                    next;
                }

                my $pipe = $self->_git->command_output_pipe( 'rev-list',
                    '--children', $rev );

                my $in = <$pipe>;
                $self->_git->command_close_pipe($pipe);
                my @children;
                if ($in) {
                    chomp($in);
                    warn "# Children of $rev: @children" if 0;
                    @children = split(/\s+/, $in);
                    shift @children;
                }

                # a branch point is:
                #  * a commit with more than one child
                #  * a tip of another branch
                if (@children > 1
                    or ( exists $branch_tips{$rev}
                        and not exists $branch_tips{$rev}{$b} )
                    )
                {
                    unshift @br_commits,
                        App::KGB::Commit->new(
                        {   log    => "Branch '$b' created",
                            id     => substr( $rev, 0, 7 ),
                            branch => $b,
                        }
                        );
                    $branch_point = $rev;
                    warn "$b branched at $rev" if 0;
                    last;
                }
                if ($parent) {
                    $ref_branch{$parent} //= $ref_branch{$rev};
                    $ref_parent{$rev} = $parent;
                }