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