Adding upstream version 3.6.12.upstream/3.6.12upstream

Signed-off-by: Daniel Baumann <daniel.baumann@progress-linux.org>

1 files changed, 144 insertions, 0 deletions

diff --git a/src/commands/info b/src/commands/info
new file mode 100755
index 0000000..b88e288
--- /dev/null
+++ b/src/commands/info
@@ -0,0 +1,144 @@
+#!/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 (see
+"wild repos") you have any kind of access to.
+
+    '-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
+    '-p'        limits output to physical repos only (no wild repo regexes!)
+
+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, $p, $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() unless $p;     # 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, $p, $patt ) = ( '', '', '', '' );
+    my $help = '';
+
+    GetOptions(
+        'lc'   => \$lc,
+        'ld'   => \$ld,
+        'json' => \$json,
+        'p'    => \$p,
+        'h'    => \$help,
+    ) or usage();
+
+    usage() if @ARGV > 1 or $help;
+    $patt = shift @ARGV || '.';
+
+    require JSON if $json;
+
+    return ( $lc, $ld, $json, $p, $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;
+}