view release on metacpan or  search on metacpan

lib/App/Git/Workflow/Command/BranchClean.pm  view on Meta::CPAN

    if (!$self->can($action)) {
        warn "Unknown action $ARGV[0]!\n";
        Pod::Usage::pod2usage( %p2u_extra, -verbose => 1 );
        return 1;
    }

    if ($option{exclude_file}) {
        for my $exclude ($workflow->slurp($option{exclude_file})) {
            chomp $exclude;
            next if !$exclude;
            next if $exclude =~ /^\s*(?:[#].*)$/xms;
            push @excludes, $exclude;
        }
    }

    BRANCH:
    for my $branch (@branches) {
        # skip master branches
        next BRANCH if $branch =~ m{^ (?:[^/]+/)? master $}xms;
        next BRANCH if grep {$branch =~ /$_/} @excludes;

        # get branch details
        my $details = $workflow->commit_details($branch, branches => 0);

        # don't delete young branches even if merged
        next BRANCH if too_young_to_die($details);

        $max = $details->{time} if $max < $details->{time};
        $deleted += __PACKAGE__->$action($branch, $details);
        $total++;
    }

    warn "Deleted $deleted of $total branches\nMax = " . (int $max/60/60/24) . "\n";

    return;
}

sub do_delete {
    my ($self, $branch, $details) = @_;

    my $too_old = too_old($details);
    my $in_master;

    if (!$too_old) {
        $in_master = in_master($details);
    }

    if ( $in_master || $too_old ) {
        warn 'deleting ' . ($in_master ? 'merged' : 'old') . " branch $branch\n";

        my ($remote, $name) = $branch =~ m{/} ? split m{/}, $branch, 2 : (undef, $branch);

        if ( $option{tag} ) {
            my $tag = $option{tag_prefix} . $name . $option{tag_suffix};
            $workflow->git->tag(qw/-a -m /, "Converting '$name' to the tag '$tag'", $tag) if !$option{test};
        }

        if ( !$option{test} ) {
            if ($remote) {
                eval {
                    $workflow->git->push($remote, '--no-verify', ":refs/heads/$name");
                    1;
                } or do {
                    return 0;
                }
            }
            else {
                $workflow->git->branch('-D', "$name");
            }
        }

        return 1;
    }

    return 0;
}

sub in_master {
    my ($details) = @_;

    my %branches = map { $_ => 1 } $workflow->branches('both', $details->{sha});

    return $branches{master} || $branches{'origin/master'};
}

sub too_old {
    my ($details) = @_;

    return if !$option{max_age};

    return time - $option{max_age} * 60 * 60 * 24 > $details->{time};
}

sub too_young_to_die {
    my ($details) = @_;

    return if !$option{min_age};

    return time - $option{min_age} * 60 * 60 * 24 < $details->{time};
}

1;

__DATA__

=head1 NAME

git-branch-clean - Clean old branches out of the repository

=head1 VERSION

This documentation refers to git-branch-clean version 1.1.20

=head1 SYNOPSIS

   git-branch-clean [option]

 OPTIONS:
  -r --remote   Only remote branches (defaults to local branches)
  -a --all      All branches
  -m --max-age[=]days