MediaWiki::USERINFO - Parse the F<USERINFO/> files in MediaWiki's Subversion repository

package MediaWiki::USERINFO;
our $VERSION = '0.04';
use 5.10.0;
use autodie ':all';
use Moose;
use MooseX::StrictConstructor;
use MooseX::Types::Moose qw<Bool Str ArrayRef HashRef>;
use File::Slurp;
use YAML::Syck qw(Load Dump);
BEGIN { $YAML::Syck::ImplicitUnicode = 1 }
use File::Temp qw(tempdir);
use File::Spec::Functions qw(catfile catdir);
use MediaWiki::USERINFO::User;
use List::MoreUtils qw(firstval uniq);
use namespace::clean -except => 'meta';

with 'MooseX::Getopt::Dashes';

has userinfo_dir => (
    isa => Str,
    is => 'ro',
    lazy_build => 1,
    documentation => 'Path to MediaWiki USERINFO directory. Default: Check it out from svn to temporary directory ',
);

sub _build_userinfo_dir {
    my ($self) = @_;

    my $tmpdir = tempdir( CLEANUP => 1 );
    system "svn co --quiet http://svn.wikimedia.org/svnroot/mediawiki/USERINFO $tmpdir";

    return $tmpdir;
}

has all_commiters => (
    isa => Str,
    is => 'ro',
    documentation => "Path to a file produced with `git log --pretty=format:%an | sort | uniq'",
);

has all_commiters_data => (
    traits => [ qw(NoGetopt) ],
    isa => ArrayRef,
    is => 'ro',
    auto_deref => 1,
    lazy_build => 1,
);

sub _build_all_commiters_data {
    my ($self) = @_;
    my $file = $self->all_commiters;

    chomp(my @users = read_file($file));

    return \@users;
}

has users => (
    traits => [ qw(NoGetopt) ],
    isa => ArrayRef,
    is => 'ro',
    auto_deref => 1,
    lazy_build => 1,
);

sub _build_users {
    my ($self) = @_;

    opendir my $dir, $self->userinfo_dir;
    my @users = sort { $a cmp $b } grep { -f catfile($self->userinfo_dir, $_) } readdir $dir;
    closedir $dir;

    return \@users;
}

has all_users => (
    traits => [ qw(NoGetopt) ],
    isa => ArrayRef,
    is => 'ro',
    auto_deref => 1,
    lazy_build => 1,
);

sub _build_all_users {
    my ($self) = @_;

    return [ uniq($self->users, $self->all_commiters_data) ];
}

has users_data => (
    traits => [ qw(NoGetopt) ],
    isa => HashRef,
    is => 'ro',
    auto_deref => 1,
    lazy_build => 1,
);

sub _build_users_data {
    my ($self) = @_;

    my @users = $self->users;
    my %users;

    for my $user (@users) {
        my $file = catfile($self->userinfo_dir, $user);
        my $data = $self->_parse_userinfo($file);

        $users{$user} = MediaWiki::USERINFO::User->new(
            user => $user,
            data => $data,
        );
    }

    return \%users;
}

sub find_user {
    my ($self, $needle) = @_;

    my %users = $self->users_data;
    return firstval { $_->user eq $needle or $_->is_alias_of($needle) } values %users;
}

# Getopt stuff
has help => (
    isa           => Bool,
    is            => 'ro',
    default       => 0,
    documentation => 'This help message',
);

has print_users => (
    traits        => [qw(Getopt)],
    cmd_flag      => 'users',
    documentation => 'Print a list of known users',
    isa           => Bool,
    is            => 'ro',
);

has print_user_info => (
    traits        => [qw(Getopt)],
    cmd_flag      => 'user-info',
    documentation => 'Dump known info for a given user',
    isa           => Str,
    is            => 'ro',
);

has print_spew_env_filter => (
    traits        => [qw(Getopt)],
    cmd_flag      => 'spew-env-filter',
    documentation => "Dump a program for use with git filter-branch's --env-filter command",
    isa           => Bool,
    is            => 'ro',
);

sub run {
    my ($self) = @_;

    if ($self->print_users) {
        say for $self->users;
        return;
    }

    if (my $name = $self->print_user_info) {
        if (my $user = $self->find_user($name)) {
            my %info = (
                user => $user->user,
                name => $user->name,
                email => $user->email,
                aliases => [ $user->aliases ],
            );
            
            print Dump(\%info); 
            return;
        } else {
            say STDERR "Can't find user $name";
        }
    }

    if ($self->print_spew_env_filter) {
        say $self->get_filter_program;
    }
}

sub get_filter_program {
    my ($self) = @_;

    my @all_users = $self->all_users;
    my $str;

    $str .= <<"PROGRAM";
#!/usr/bin/env perl
use 5.10.0;
use utf8;
use strict;


my \$an = \$ENV{GIT_COMMITER_NAME\};
my \$am;

given (\$an) {
PROGRAM

    for my $u (@all_users) {
        my $v = $self->find_user($u);

        next unless $v;

        my $user  = $v->user;
        my $name  = $v->name  // $user;
        my $email = $v->email // '';

        $str .= <<"PROGRAM"
    when (q[$u]) {
        \$an = q[$name];
        \$am = q[$email]
    }
PROGRAM
    }

    $str .= <<"PROGRAM";
}

\$ENV{GIT_COMMITER_NAME}  = \$an if \$an;
\$ENV{GIT_COMMITER_EMAIL} = \$am if \$am;
PROGRAM

    return $str;
    
}

sub _read_file {
    my ($self, $file) = @_;
    open my $fh, '<:encoding(utf8)', $file;
    my $cont = join '', <$fh>;
    close $fh;
    return $cont;
}

sub _parse_userinfo {
    my ($self, $file) = @_;
    my $cont = $self->_read_file($file);
    my $ret = Load($cont);
    return $ret;
}

__PACKAGE__->meta->make_immutable;