new 'list-dangling-repos' command
This commit is contained in:
parent
4373c5c74c
commit
57f82ee044
47
src/commands/list-dangling-repos
Executable file
47
src/commands/list-dangling-repos
Executable file
|
@ -0,0 +1,47 @@
|
|||
#!/usr/bin/perl
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use lib $ENV{GL_LIBDIR};
|
||||
use Gitolite::Common;
|
||||
|
||||
=for usage
|
||||
Usage: gitolite list-dangling-repos
|
||||
|
||||
List all existing repos that no one can access remotely any more. They could
|
||||
be normal repos that were taken out of "repo" statements in the conf file, or
|
||||
wildcard repos whose matching "wild" pattern was taken out or changed so it no
|
||||
longer matches.
|
||||
=cut
|
||||
|
||||
usage() if @ARGV and $ARGV[0] eq '-h';
|
||||
|
||||
# get the two lists we need. %repos is the list of repos in "repo" statements
|
||||
# in the conf file. %phy_repos is the list of actual repos on disk. Our job
|
||||
# is to cull %phy_repos of all keys that have a matching key in %repos, where
|
||||
# "matching" means "string equal" or "regex match".
|
||||
my %repos = map { chomp; $_ => 1 } `gitolite list-repos`;
|
||||
my %phy_repos = map { chomp; $_ => 1 } `gitolite list-phy-repos`;
|
||||
|
||||
# Remove exact matches. But for repo names like "gtk+", you could have
|
||||
# collapsed this into the next step (the regex match).
|
||||
for my $pr (keys %phy_repos) {
|
||||
next unless exists $repos{$pr};
|
||||
delete $repos{$pr};
|
||||
delete $phy_repos{$pr};
|
||||
}
|
||||
|
||||
# Remove regex matches.
|
||||
for my $pr (keys %phy_repos) {
|
||||
my $matched = 0;
|
||||
for my $r (keys %repos) {
|
||||
if ($pr =~ /^$r$/) {
|
||||
$matched = 1;
|
||||
next;
|
||||
}
|
||||
}
|
||||
delete $phy_repos{$pr} if $matched;
|
||||
}
|
||||
|
||||
# what's left in %phy_repos are dangling repos.
|
||||
print join("\n", sort keys %phy_repos), "\n";
|
Loading…
Reference in a new issue