~ubuntu-branches/ubuntu/utopic/gitolite3/utopic-proposed

#!/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] [<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.

 

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 two are globals

my ( $lc, $ld, $patt ) = args();

 

print_version();

 

print_patterns();     # repos he can create for himself

print_phy_repos();    # repos already created

print "\n$rc{SITE_INFO}\n" if $rc{SITE_INFO};

 

# ----------------------------------------------------------------------

 

sub args {

    my ( $lc, $ld, $patt ) = ( '', '', '' );

    my $help = '';

 

    GetOptions(

        'lc' => \$lc,

        'ld' => \$ld,

        'h'  => \$help,

    ) or usage();

 

    usage() if @ARGV > 1 or $help;

    $patt = shift @ARGV || '.';

 

    return ( $lc, $ld, $patt );

}

 

sub print_version {

    chomp( my $hn = `hostname -s 2>/dev/null || hostname` );

    my $gv = substr( `git --version`, 12 );

    $ENV{GL_USER} or _die "GL_USER not set";

    print "hello $ENV{GL_USER}, this is " . ($ENV{USER} || "httpd") . "\@$hn running gitolite3 " . version() . " on git $gv\n";

}

 

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 $creator = '';

    for my $repo (@$repos) {

        next unless $repo =~ /$patt/;

        my $perm = '';

        $creator = creator($repo) if $lc;

 

        my $desc = '';

        for my $d ("$ENV{GL_REPO_BASE}/$repo.git/description") {

            next unless $ld 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/;

        print "$perm\t$repo";

        print "\t$creator" if $lc;

        print "\t$desc" if $ld;

        print "\n";

    }

}