#!/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;
}