Skip to content
Fetching contributors…
Cannot retrieve contributors at this time
executable file 143 lines (114 sloc) 3.82 KB
#!/usr/bin/perl
use strict;
use warnings;
use Getopt::Long;
use lib $ENV{GL_LIBDIR};
use Gitolite::Rc;
use Gitolite::Common;
use Gitolite::Conf::Load;
=for args
Usage: gitolite info [-lc] [-ld] [-json] [<repo name pattern>]
List all existing repos you can access, as well as repo name patterns you can
create repos from (if any).
'-lc' lists creators as an additional field at the end.
'-ld' lists description as an additional field at the end.
'-json' produce JSON output instead of normal output
The optional pattern is an unanchored regex that will limit the repos
searched, in both cases. It might speed up things a little if you have more
than a few thousand repos.
=cut
# these are globals
my ( $lc, $ld, $json, $patt ) = args();
my %out; # holds info to be json'd
$ENV{GL_USER} or _die "GL_USER not set";
if ($json) {
greeting(\%out);
} else {
print greeting();
}
print_patterns(); # repos he can create for himself
print_phy_repos(); # repos already created
if ( $rc{SITE_INFO} ) {
$json
? $out{SITE_INFO} = $rc{SITE_INFO}
: print "\n$rc{SITE_INFO}\n";
}
print JSON::to_json( \%out, { utf8 => 1, pretty => 1 } ) if $json;
# ----------------------------------------------------------------------
sub args {
my ( $lc, $ld, $json, $patt ) = ( '', '', '', '' );
my $help = '';
GetOptions(
'lc' => \$lc,
'ld' => \$ld,
'json' => \$json,
'h' => \$help,
) or usage();
usage() if @ARGV > 1 or $help;
$patt = shift @ARGV || '.';
require JSON if $json;
return ( $lc, $ld, $json, $patt );
}
sub print_patterns {
my ( $repos, @aa );
my $lm = \&Gitolite::Conf::Load::list_members;
# find repo patterns only, call them with ^C flag included
@$repos = grep { !/$REPONAME_PATT/ } map { /^@/ ? @{ $lm->($_) } : $_ } @{ lister_dispatch('list-repos')->() };
@aa = qw(R W ^C);
listem( $repos, '', '', @aa );
# but squelch the 'lc' and 'ld' flags for these
}
sub print_phy_repos {
my ( $repos, @aa );
# now get the actual repos and get R or W only
_chdir( $rc{GL_REPO_BASE} );
$repos = list_phy_repos(1);
@aa = qw(R W);
listem( $repos, $lc, $ld, @aa );
}
sub listem {
my ( $repos, $lc, $ld, @aa ) = @_;
my @list;
my $mlr = 0; # max length of reponame
my $mlc = 0; # ...and creator
for my $repo (@$repos) {
next unless $repo =~ /$patt/;
my $creator = '';
my $desc = '';
my $perm = '';
$creator = creator($repo) if $lc;
if ($ld) {
# use config value first, else 'description' file as second choice
my $k = 'gitweb.description';
my $d = "$ENV{GL_REPO_BASE}/$repo.git/description";
$desc = git_config( $repo, $k )->{$k} || '';
if ( !$desc and -r $d ) {
$desc = slurp($d);
chomp($desc);
}
}
for my $aa (@aa) {
my $ret = access( $repo, $ENV{GL_USER}, $aa, 'any' );
$perm .= ( $ret =~ /DENIED/ ? " " : " $aa" );
}
$perm =~ s/\^//;
next unless $perm =~ /\S/;
if ($json) {
$out{repos}{$repo}{creator} = $creator if $lc;
$out{repos}{$repo}{description} = $desc if $ld;
$out{repos}{$repo}{perms} = _hash($perm);
} else {
$mlr = length($repo) if ( $lc or $ld ) and $mlr < length($repo);
$mlc = length($creator) if $lc and $ld and $mlc < length($creator);
push @list, [ $perm, $repo, $creator, $desc ];
}
}
return if $json;
my $fmt = "%s\t%-${mlr}s\t%-${mlc}s\t%s\n";
map { s/\t\t/\t/; s/\s*$/\n/; print } map { sprintf $fmt, @$_ } @list;
}
sub _hash {
my $in = shift;
my %out = map { $_ => 1 } ( $in =~ /(\S)/g );
return \%out;
}
Jump to Line
Something went wrong with that request. Please try again.